home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 095 / rbbssrc2.arc / RBBSSUB1.BAS < prev    next >
BASIC Source File  |  1987-03-15  |  82KB  |  2,210 lines
  1. ' $linesize:132
  2. ' $title: 'RBBS-SUB1.BAS CPC15-1A, Copyright 1986, 87 by D. Thomas Mack'
  3. '  Copyright 1987 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB1.BAS
  5. '  Written by .........: D. Thomas Mack
  6. '  First Released .....: June 29, 1986
  7. '  Subsequent Releases.: September 28, 1986, March 15, 1987
  8. '  Copyright ..........: 1986, 1987
  9. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  10. '                        RBBS-PC.BAS utilizes a lot of common subroutines.
  11. '                        Those that require error trapping are incorporated
  12. '                        within RBBSSUB1.BAS as separately callable subroutines
  13. '                        in order to free up as much code as possible within
  14. '                        the 64K code segment used by RBBS-PC.BAS.
  15. '  Parameters..........: Most parameters are passed via a COMMON statement.
  16. '
  17. ' Subroutine  Line               Function of Subroutine
  18. '   Name     Number
  19. '  ANSWERIT     201   Answer the telephone when it rings
  20. '  ASKUSERS   64005   Ask users questions based on a script and save answers
  21. '  BAUD450     5507   Allow 300 baud callers to bump up to 450 baud
  22. '  FINDFREE   52000   Find amount of space on the upload disk drive
  23. '  FINDIT     20221   Find if a file exists on a device
  24. '  FINDUSER   12610   Find a user in the USERS file
  25. '  LINEEDIT    3700   Edit a line while minimizing string space consumption
  26. '  OPENRSEQ    1479   Open a sequential file (number 2) for random I/O
  27. '  OPENFMS    58190   Open the upload management system directory
  28. '  OPENUSER    9400   Open the USER file (number 5)
  29. '  OPENWORK   58000   Open RBBS-PC's work file (number 2)
  30. '  PASSWORD     667   Verify User & Message Passwords
  31. '  PRINTIT    13674   Print line on the local PC running RBBS-PC printer
  32. '  READDEF      117   Open and read RBBS-PC's ".DEF" file of parameters
  33. '  SENDNAME   20295   Send filename via EXEC-PC protocol during autodownload
  34. '  TESTUSER   20310   Check if user's software can do auto downloading
  35. '  TGET        1500   Read a line from the communications port
  36. '  TPUT        1400   Write a line to the communications port
  37. '  UPDATEC    43050   Update the caller's file with elasped session time
  38. '  UPDTCALR   13665   Update to the caller's file
  39. '
  40. '  $INCLUDE: 'RBBS-VAR.BAS'
  41. '
  42. ' $SUBTITLE: 'READDEF - subroutine to read RBBS-PC.DEF file'
  43. ' $PAGE
  44. '
  45. '  SUBROUTINE NAME    -- READDEF
  46. '
  47. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  48. '                         CONFIG.FILENAME$            NAME OF RBBS-PC.DEF FILE
  49. '                         SUBROUTINE.PARAMETER = -62  ONLY READ THE .DEF FILE
  50. '
  51. '  OUTPUT PARAMETERS  --  ALL THE RBBS-PC.DEF PARAMETERS
  52. '
  53. '  SUBROUTINE PURPOSE --  TO READ THE PARAMETERS FROM THE RBBS-PC.DEF FILE
  54.      SUB READDEF STATIC
  55.      ON ERROR GOTO 65000
  56. '
  57. ' *****************************************************************************
  58. ' *  OPEN AND READ RBBS-PC CONFIGURATION DEFINITIONS                          *
  59. ' *****************************************************************************
  60. '
  61. 117 CLOSE 2
  62.     OPEN "I",2,CONFIG.FILENAME$
  63.     INPUT #2,DOWNLOAD.DRIVES$, _
  64.              SYSOP.PASSWORD.1$, _
  65.              SYSOP.PASSWORD.2$, _
  66.              SYSOP.FIRST.NAME$, _
  67.              SYSOP.LAST.NAME$, _
  68.              REQUIRED.RINGS, _
  69.              START.OFFICE.HOURS, _
  70.              END.OFFICE.HOURS, _
  71.              MINUTES.PER.SESSION!, _
  72.              DF, _
  73.              DF, _
  74.              UPLOAD.DIRECTORY$, _
  75.              EXPERT.USER, _
  76.              ACTIVE.BULLETINS, _
  77.              PROMPT.BELL, _
  78.              DF, _
  79.              DF, _
  80.              MENU$(1), _
  81.              MENU$(2), _
  82.              MENU$(3), _
  83.              MENU$(4), _
  84.              MENU$(5), _
  85.              CONFERENCE.MENU$, _
  86.              DF, _
  87.              WELCOME.INTERRUPTABLE, _
  88.              REMIND.FILE.TRANSFERS, _
  89.              PAGE.LENGTH, _
  90.              MAX.MESSAGE.LINES, _
  91.              DOORS.AVAILABLE, _
  92.              DF$
  93.     INPUT #2,MAIN.MESSAGE.FILE$, _
  94.              MAIN.MESSAGE.BACKUP$, _
  95.              CALLERS.FILE$, _
  96.              COMMENTS.FILE$, _
  97.              MAIN.USER.FILE$, _
  98.              WELCOME.FILE$, _
  99.              NEWUSER.FILE$, _
  100.              DIRECTORY.EXTENTION$, _
  101.              COM.PORT$, _
  102.              BULLETINS.OPTIONAL, _
  103.              MODEM.INIT.COMMAND$, _
  104.              DF$, _
  105.              DF, _
  106.              FG, _
  107.              BG, _
  108.              BORDER, _
  109.              RBBS.BAT$, _
  110.              RCTTY.BAT$
  111.              DOS.VERSION = 2
  112.     INPUT #2,OMIT.MAIN.DIRECTORY$, _
  113.              DUMMY$, _
  114.              HELP$(3), _
  115.              HELP$(4), _
  116.              HELP$(7), _
  117.              HELP$(9), _
  118.              BULLETIN.MENU$, _
  119.              BULLETIN.PREFIX$, _
  120.              DF$, _
  121.              MESSAGE.REMINDER, _
  122.              REQUIRE.NON.ASCII, _
  123.              DOORS.SECURITY.LEVEL, _
  124.              MAXIMUM.NUMBER.OF.NODES, _
  125.              NETWORK.TYPE, _
  126.              RECYCLE.TO.DOS, _
  127.              DF, _
  128.              DF, _
  129.              TRASHCAN.FILE$
  130.     INPUT #2,MINIMUM.LOGON.SECURITY, _
  131.              DEFAULT.SECURITY.LEVEL, _
  132.              SYSOP.SECURITY.LEVEL, _
  133.              FILESEC.FILE$, _
  134.              SYSOP.MENU.SECURITY.LEVEL, _
  135.              LOCAL.PASSWORD$, _
  136.              MAXIMUM.VIOLATIONS, _
  137.              OPT.SEC(40), _   ' SECURITY FOR SYSOP COMMANDS 1
  138.              OPT.SEC(41), _
  139.              OPT.SEC(42), _
  140.              OPT.SEC(43), _
  141.              OPT.SEC(44), _
  142.              OPT.SEC(45), _
  143.              OPT.SEC(46), _   ' SYSOP 7
  144.              PASSWORDS.FILE$, _
  145.              MAXIMUM.PASSWORD.CHANGES, _
  146.              MINIMUM.SECURITY.FOR.TEMP.PASSWORD, _
  147.              OVERWRITE.SECURITY.LEVEL, _
  148.              DOORS.TERMINAL.TYPE, _
  149.              LIMIT.DAILY.TIME
  150.     INPUT #2,OPT.SEC(1), _   ' SECURITY FOR MAIN MENU COMMANDS 1
  151.              OPT.SEC(2), _
  152.              OPT.SEC(3), _
  153.              OPT.SEC(4), _
  154.              OPT.SEC(5), _
  155.              OPT.SEC(6), _
  156.              OPT.SEC(7), _
  157.              OPT.SEC(8), _
  158.              OPT.SEC(9), _
  159.              OPT.SEC(10), _
  160.              OPT.SEC(11), _
  161.              OPT.SEC(12), _
  162.              OPT.SEC(13), _
  163.              OPT.SEC(14), _
  164.              OPT.SEC(15), _
  165.              OPT.SEC(16), _
  166.              OPT.SEC(17), _   ' MAIN COMMAND 17
  167.              DEFAULT.MACHINE.TYPE$, _
  168.              WAIT.BEFORE.DISCONNECT
  169.     INPUT #2,OPT.SEC(18), _      ' Security for FILE COMMANDS 1
  170.              OPT.SEC(19), _
  171.              OPT.SEC(20), _
  172.              OPT.SEC(21), _
  173.              OPT.SEC(22), _
  174.              OPT.SEC(23), _
  175.              OPT.SEC(24), _      ' FILE COMMAND 7
  176.              OPT.SEC(25), _      ' SECURITY FOR UTILITY COMMANDS 1
  177.              OPT.SEC(26), _
  178.              OPT.SEC(27), _
  179.              OPT.SEC(28), _
  180.              OPT.SEC(29), _
  181.              OPT.SEC(30), _
  182.              OPT.SEC(31), _
  183.              OPT.SEC(32), _
  184.              OPT.SEC(33), _
  185.              OPT.SEC(34), _
  186.              OPT.SEC(35), _   ' UTIL COMMAND 11
  187.              OPT.SEC(36), _   ' SECURITY FOR GLOBAL COMMANDS 1
  188.              OPT.SEC(37), _
  189.              OPT.SEC(38), _
  190.              OPT.SEC(39), _   ' GLOBAL 4
  191.              UPLOAD.TIME.FACTOR!, _
  192.              COMPUTER.TYPE, _
  193.              REMIND.PROFILE, _
  194.              RBBS.NAME$, _
  195.              COMMANDS.BETWEEN.RINGS, _
  196.              MNP.SUPPORT, _
  197.              PAGING.PRINTER.SUPPORT$, _
  198.              MODEM.INIT.BAUD$
  199. 118 INPUT #2, TURN.PRINTER.OFF,_    ' Turn printer off after each recycle
  200.               DIRECTORY.PATH$, _    ' Where dir files are stored
  201.               MIN.SEC.TO.VIEW, _
  202.               LIMIT.SEARCH.TO.FMS, _
  203.               DEFAULT.CATEGORY.CODE$, _
  204.               DIR.CATEGORY.FILE$, _
  205.               NEW.FILES.CHECK, _
  206.               MAX.DESC.LEN, _
  207.               SHOW.SECTION, _
  208.               COMMANDS.IN.PROMPT, _
  209.               NEWUSER.SETS.DEFAULTS, _
  210.               HELP.PATH$, _
  211.               HELP.EXTENSION$, _
  212.               MAIN.COMMANDS$, _
  213.               FILE.COMMANDS$, _
  214.               UTIL.COMMANDS$, _
  215.               GLOBAL.COMMANDS$, _
  216.               SYSOP.COMMANDS$
  217.       ALL.OPTS$ = MAIN.COMMANDS$ + FILE.COMMANDS$ + UTIL.COMMANDS$ + _
  218.                   GLOBAL.COMMANDS$ + SYSOP.COMMANDS$
  219.       HELP.EXTENSION$ = "." + HELP.EXTENSION$
  220.       BEG.MAIN = 1
  221.       BEG.FILE = LEN(MAIN.COMMANDS$) + BEG.MAIN
  222.       BEG.UTIL = LEN(FILE.COMMANDS$) + BEG.FILE
  223.       HELP$(3) = HELP.PATH$ + HELP$(3)
  224.       HELP$(4) = HELP.PATH$ + HELP$(4)
  225.       HELP$(7) = HELP.PATH$ + HELP$(7)
  226.       HELP$(9) = HELP.PATH$ + HELP$(9)
  227. '
  228. ' *****************************************************************************
  229. ' *  ESTABLISH COMMUNICATION PORT REGISTERS AND COMMANDS                      *
  230. ' *  GET DOS SUB-DIRECTORY RBBS-PC OPTIONS                                    *
  231. ' *****************************************************************************
  232. '
  233.     INPUT #2, UPLOAD.PATH$, _              ' Where upl dir goes
  234.               FMS.DIRECTORY$, _            ' Shared dir in FMS
  235.               ANS.MENU$, _
  236.               REQUIRED.QUESTIONNAIRE$,_
  237.               REMEMBER.NEW.USERS,_
  238.               SURVIVE.NOUSER.ROOM,_
  239.               PROMPT.HASH$,_
  240.               START.HASH,_
  241.               LEN.HASH,_
  242.               PROMPT.INDIV$,_
  243.               START.INDIV,_
  244.               LEN.INDIV
  245.     INPUT #2, BYPASS.MSGS, _
  246.               MUSIC, _
  247.               RESTRICT.BY.DATE, _
  248.               DAYS.TO.WARN, _
  249.               DAYS.IN.SUBSCRIPTION.PERIOD, _
  250.               CALLBACK.VERIFICATION, _
  251.               RESTRICT.VALID.CMDS, _
  252.               NEW.USER.DEFAULT.MODE, _
  253.               NEW.USER.LINE.FEEDS, _
  254.               NEW.USER.NULLS, _
  255.               NEW.USER.BELL, _
  256.               NEW.USER.CASE, _
  257.               NEW.USER.MARGINS, _
  258.               WRAP.CALLERS.FILE$, _
  259.               REDIRECT.IO.METHOD, _
  260.               GO.TO.SHELL, _
  261.               HALT.ON.ERROR, _
  262.               NEW.PUBLIC.MSGS.SECURITY, _
  263.               NEW.PRIVATE.MSGS.SECURITY, _
  264.               SECURITY.NEEDED.TO.CHANGE.MSGS, _
  265.               SL.CATEGORIZE.UPLOADS, _
  266.               BAUDOT, _
  267.               TIME.TO.DROP.TO.DOS, _
  268.               EXPIRED.SECURITY, _
  269.               DTR.DROP.DELAY, _
  270.               ASK.IDENTITY, _
  271.               USE.EXTERNAL.XMODEM, _
  272.               BUFFER.SIZE, _
  273.               MLCOM, _
  274.               DUMMY, _
  275.               F7.MESSAGE$, _
  276.               NEW.USER.DEFAULT.PROTOCOL$, _
  277.               NEW.USER.GRAPHICS$, _
  278.               NET.MAIL$, _
  279.               MASTER.DIRECTORY.NAME$, _
  280.               PROTOCOL.PATH$, _
  281.               UPCAT.HELP$, _
  282.               ALWAYS.STREW.TO$, _
  283.               DUMMY$
  284.     INPUT #2, DF,_
  285.               MODEM.INIT.WAIT.TIME, _
  286.               MODEM.COMMAND.DELAY.TIME, _
  287.               TURBO.RBBS, _
  288.               SUBDIR.COUNT,_
  289.               DF,_
  290.               UPLOAD.TO.SUBDIR,_
  291.               DF,_
  292.               UPLOAD.SUBDIR$,_
  293.               RESTRICT.BAUD,_
  294.               USE.COLOR,_
  295.               DISKFULL.GO.OFFLINE,_
  296.               EXTENDED.LOGGING,_
  297.               MODEM.RESET.COMMAND$,_
  298.               MODEM.COUNT.RINGS.COMMAND$,_
  299.               MODEM.ANSWER.COMMAND$,_
  300.               MODEM.GO.OFFHOOK.COMMAND$,_
  301.               DISK.FOR.DOS$, _
  302.               DUMB.MODEM, _
  303.               COMMENTS.AS.MESSAGES, _
  304.               LSB,_
  305.               MSB,_
  306.               LINE.CONTROL.REGISTER,_
  307.               MODEM.CONTROL.REGISTER,_
  308.               LINE.STATUS.REGISTER,_
  309.               MODEM.STATUS.REGISTER
  310.        IF SUBROUTINE.PARAMETER = -62 THEN _
  311.           EXIT SUB
  312.        REQUIRED.QUESTIONNAIRE$ = REQUIRED.QUESTIONNAIRE$ + ".DEF"
  313. '
  314. ' *****************************************************************************
  315. ' *  ESTABLISH RBBS-PC'S DOS SUBDIRECTORIES USAGE                             *
  316. ' *****************************************************************************
  317. '
  318.     IF FMS.DIRECTORY$ <> "" THEN _
  319.        FMS.DIRECTORY$ = DIRECTORY.PATH$ + _
  320.                         FMS.DIRECTORY$ + _
  321.                         "." + _
  322.                         DIRECTORY.EXTENTION$
  323.     UPCAT.HELP$ = HELP.PATH$ + UPCAT.HELP$ + HELP.EXTENSION$
  324.     IF SUBDIR.COUNT<1 THEN _
  325.        GOTO 123
  326.     FOR SUBDIR.INDEX = 1 TO SUBDIR.COUNT
  327.         INPUT #2,SUBDIR$
  328.         IF RIGHT$(SUBDIR$,1) <> "\" THEN _
  329.           SUBDIR$(SUBDIR.INDEX) = SUBDIR$ + "\" _
  330.         ELSE SUBDIR$(SUBDIR.INDEX) = SUBDIR$
  331.     NEXT
  332.     GOTO 125
  333. '
  334. ' *****************************************************************************
  335. ' *  SETUP DOWNLOAD DRIVES WITH NO SUBDIRECTORY SUPPORT                       *
  336. ' *****************************************************************************
  337. '
  338. 123 FOR SUBDIR.INDEX = 1 TO LEN(DOWNLOAD.DRIVES$) - 1
  339.         SUBDIR$(SUBDIR.INDEX) = MID$(DOWNLOAD.DRIVES$,SUBDIR.INDEX,1) + ":"
  340.     NEXT
  341.     SUBDIR.COUNT = LEN(DOWNLOAD.DRIVES$) - 1
  342. '
  343. ' *****************************************************************************
  344. ' *  SETUP UPLOAD DRIVE AND DIRECTORY.NAME                                    *
  345. ' *****************************************************************************
  346. '
  347. 125 UPLOAD.DIR.CHECK$ = UPLOAD.DIRECTORY$
  348.     SUBDIR.COUNT = SUBDIR.COUNT + 1
  349.     IF UPLOAD.TO.SUBDIR THEN _
  350.        SUBDIR$(SUBDIR.COUNT) = UPLOAD.SUBDIR$ + "\" _
  351.     ELSE SUBDIR$(SUBDIR.COUNT) = RIGHT$(DOWNLOAD.DRIVES$,1) + _
  352.          ":"
  353.     UPLOAD.DIRECTORY$ = UPLOAD.DIRECTORY$ + _
  354.                         "." + _
  355.                         DIRECTORY.EXTENTION$
  356.     CALL CHKNARY (SUBDIR$(SUBDIR.COUNT),SUBDIR$(),SUBDIR.COUNT-1,FOUND)
  357.     CAN.DOWNLOAD.FROM.UP = (FOUND > 0)
  358.     UPLOAD.DIRECTORY$ = UPLOAD.PATH$ + UPLOAD.DIRECTORY$
  359. 126 CLOSE #2
  360. '
  361. ' *****************************************************************************
  362. ' *  INITIALIZE OMNINET INTERFACE IF OMNINET IN USE                           *
  363. ' *****************************************************************************
  364. '
  365. 128 IF NETWORK.TYPE = 2 THEN _
  366.        CN$ = SPACE$(535) : _
  367.        CALL INITIO(A)
  368.     END SUB
  369. ' $SUBTITLE: 'ANSWERIT - subroutine to answer the phone when it rings'
  370. ' $PAGE
  371. '
  372. '  SUBROUTINE NAME    -- ANSWERIT
  373. '
  374. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  375. '                       SUBROUTINE.PARAMETER = 1   WAIT FOR PHONE TO RING
  376. '                       SUBROUTINE.PARAMETER = 2   CONTINUE LOOKING FOR CONNECT
  377. '                       SUBROUTINE.PARAMETER = 3   RENTRY AFTER FUNCTION KEY
  378. '                       SUBROUTINE.PARAMETER = 4   GO ON LINE IMMEDIATELY
  379. '                       BG                         LOCAL DISPLAY'S BACKGROUND
  380. '                       BORDER                     LOCAL DISPLAY'S BORDER COLOR
  381. '                       COLOR.SUPPORT              ANSI.SYS SUPPORT INDICATOR
  382. '                       COM.PORT$                  COMMUNICATIONS PORT NAME
  383. '                       COMPUTER.TYPE              TYPE OF COMPUTER RUNNING ON
  384. '                       DUMB.MODEM                 NON-HAYES TYPE MODEM FLAG
  385. '                       EXTENDED.LOGGING           EXTENDED CALLERS LOG FLAG
  386. '                       FG                         LOCAL DISPLAY'S FOREGROUND
  387. '                       MODEM.ANSWER.COMMAND$      COMMAND TO ANSWER PHONE
  388. '                       MODEM.CONTROL.REGISTER     LOCATION OF MODEM CNTRL. REG
  389. '                       MODEM.COUNT.RINGS.COMMAND$ COMMAND TO COUNT PHONE RINGS
  390. '                       MODEM.INIT.BAUD$           BAUDE AT WHICH TO OPEN COMM.
  391. '                       MODEM.RESET.COMMAND$       COMMAND TO RESET THE MODEM
  392. '                       MODEM.STATUS.REGISTER      LOCATION OF MODEM STATUS REG
  393. '                       PRINTER                    FLAG TO PRINT ON LOCAL PRT.
  394. '                       RESTRICT.BAUD              FLAG TO DISALLOW 300 BAUD
  395. '                       REQUIRED.RINGS             NUMBER OF RINGS TO ANSWER ON
  396. '                       SNOOP                      FLAG TO DISPLAY ON LOCAL PC
  397. '                       SYSOP.NEXT                 FLAG TO GIVE SYSOP CONTROL
  398. '
  399. '  OUTPUT PARAMETERS -- BAUD.TEST                  BAUD RATE TO SET RS232 AT
  400. '                       EIGHT.BIT                  PARITY INDICATOR
  401. '                       RELIABLE.MODE              INDICATES MODEM-SUPPLIED
  402. '                                                  "ERROR-FREE" PROTOCOL ACTIVE
  403. '                       SUBROUTINE.PARAMETER = 1   CARRIER DETECT FOUND (I.E.
  404. '                                                  MODEM AUTO-ANSWERED).
  405. '                                            = 2   ANSWERED THE PHONE AND
  406. '                                                  CARRIER DETECT OCCURRED.
  407. '                                            = 3   SYSOP HIT "ESC" KEY ON THE
  408. '                                                  LOCAL KEYBOARD.
  409. '                                            = 4   ANSWERED THE PHONE BUT NO
  410. '                                                  CARRIER WAS DETECTED.
  411. '                                            = 5   NOT USED.
  412. '                                            = 6   FUNCTION KEY PRESSED ON THE
  413. '                                                  LOCAL KEYBOARD.
  414. '
  415. '  SUBROUTINE PURPOSE -- TO ANSWER THE TELEPHONE WHEN IT RINGS.
  416. '
  417.       SUB ANSWERIT STATIC
  418.       ON ERROR GOTO 65000
  419.       EC = 0
  420.       RELIABLE.MODE = FALSE
  421.       FF = SUBROUTINE.PARAMETER
  422.       SUBROUTINE.PARAMETER = 0
  423.       ON FF GOTO 201,324,245,320
  424. '
  425. ' *****************************************************************************
  426. ' *  INITIALIZE MODEM AND ANNOUNCE RBBS-PC IS UP AND READY FOR CALLS          *
  427. ' *****************************************************************************
  428. '
  429. 201 SUBROUTINE.PARAMETER = -10
  430.     CALL CARRIER
  431.     IF SUBROUTINE.PARAMETER = 0 THEN _
  432.        GOTO 210
  433. '
  434. ' *****************************************************************************
  435. ' *  RESET THE MODEM VIA THE MODEM CONTROL REGISTER  TO ASSURE IT IS READY    *
  436. ' *****************************************************************************
  437. '
  438.     OUT MODEM.CONTROL.REGISTER,&H4
  439.     CALL DELAYIT (MODEM.INIT.WAIT.TIME)
  440. '
  441. ' *****************************************************************************
  442. ' *  CLEAR THE MODEM CONTROL REGISTER PRIOR TO OPEN THE COMMUNICATIONS PORT   *
  443. ' *****************************************************************************
  444. '
  445.     OUT MODEM.CONTROL.REGISTER,&H0
  446.     CALL DELAYIT (MODEM.INIT.WAIT.TIME)
  447. 210 OPEN COM.PORT$ + ":" + MODEM.INIT.BAUD$ + ",N,8,1,RS,CD,DS" AS #3
  448. 220 SUBROUTINE.PARAMETER = 1
  449.     CALL AMORPM
  450. 230 IF PRINTER THEN _
  451.        CALL PRINTIT (" RBBS-PC "+VERSION.ID$+" Node "+NODE.ID$+_
  452.                      " up "+TIM$+" on "+DATE$)
  453. 235 EIGHT.BIT = TRUE
  454.     SUBROUTINE.PARAMETER = -10
  455.     CALL CARRIER
  456.     IF SUBROUTINE.PARAMETER = 0 AND _
  457.        EXIT.TO.DOORS THEN _
  458.        CALL READPROF : _
  459.        SUBROUTINE.PARAMETER = 1 : _
  460.        GOTO 335
  461.     IF SUBROUTINE.PARAMETER = 0 THEN _
  462.        GOTO 324
  463.     PCJR = FALSE
  464.     IF COMPUTER.TYPE = 2 AND _
  465.        COM.PORT$ = "COM1" AND _
  466.        MODEM.STATUS.REGISTER = 1022 THEN _
  467.        MODEM.GO.OFFHOOK.COMMAND$ = CHR$(14) + "P" : _
  468.        PCJR = TRUE
  469.     IF PCJR THEN _
  470.        A$ = CHR$(14) + "I" _
  471.     ELSE A$ = MODEM.RESET.COMMAND$
  472.     CALL MODEMPUT (A$)
  473.     CALL SYSMENU
  474.     CALL DELAYIT (MODEM.INIT.WAIT.TIME)
  475.     IF PCJR THEN _
  476.        A$ = CHR$(14) + _   ' PC-JR'S MODEM COMMAND IDENTIFIER
  477.           "C 0," + _   ' SET "AUTO-ANSWER" OFF ON PC-JR'S MODEM
  478.           "S 1," + _   ' SET SPEED TO 300 BAUD ON PC-JR'S MODEM
  479.           "H" _        ' MANUALLY HANG UP THE PHONE (IF NOT ALREADY)
  480.        ELSE A$ = MODEM.INIT.COMMAND$
  481.     CALL MODEMPUT (A$)
  482.     IF PCJR THEN _
  483.        A$ = CHR$(14) + "F 4" : _
  484.        CALL MODEMPUT (A$)
  485.     RINGBACK = FALSE
  486.     LOCATE 22,3
  487.     IF REQUIRED.RINGS = 0 THEN _
  488.        PRINT "WAITING FOR CARRIER"; : _
  489.        GOTO 237
  490.     IF MID$(MODEM.INIT.COMMAND$, _
  491.       INSTR(MODEM.INIT.COMMAND$,"S0")+3,3) = "255" THEN _
  492.        PRINT "RING BACK SYSTEM"; : _
  493.        RINGBACK = TRUE : _
  494.        GOTO 236
  495.     PRINT "WAITING FOR RING ";
  496. 236 LOCATE 22,24 : _
  497.     PRINT MID$(STR$(REQUIRED.RINGS),2);
  498. 237 LOCATE 18,51
  499.     COLOR FG+16
  500.     PRINT "YES";
  501.     COLOR FG
  502.     LOCATE 22,28
  503. '
  504. ' *****************************************************************************
  505. ' *  GET READY TO ANSWER INCOMMING CALL:                                      *
  506. ' *       1.  LET THE MODEM "AUTO-ANSWER" FOR RBBS-PC.                        *
  507. ' *           REQUIRED RINGS = 0 AND S0 = 1 IN MODEM INIT COMMAND.            *
  508. ' *       2.  ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS.                *
  509. ' *           REQUIRED RINGS > 0 AND S0 = 254 IN MODEM INIT COMMAND.          *
  510. ' *       3.  ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS AFTER A USER    *
  511. ' *           FIRST CALLS AND THEN HANGS UP (I.E. RING-BACK).                 *
  512. ' *           REQUIRED RINGS > 0 AND S0 = 255 IN MODEM INIT COMMAND.          *
  513. ' *****************************************************************************
  514. '
  515.     QQ = 255
  516.     I = INSTR(MODEM.INIT.COMMAND$,"S0")
  517.     IF I = 0 OR PCJR THEN _
  518.        GOTO 239
  519.     IF VAL(MID$(MODEM.INIT.COMMAND$,I+3,3)) = 255 THEN _
  520.        QQ = 0 : _
  521.        BLK = QQ
  522.     CALL FINDTIME (TCA!)
  523.     SUBROUTINE.PARAMETER = 1
  524.     CALL LINE25
  525.     RING.ANSWER = TRUE
  526.     IF RINGBACK THEN _
  527.        RING.ANSWER = FALSE
  528. 239 RINGBACK.WAIT.STARTED! = 0
  529.     IF RINGBACK THEN _
  530.        CALL FINDTIME (RINGBACK.WAIT.STARTED!) : _
  531.        COLOR 7,0,0 _
  532.     ELSE COLOR FG,BG,BORDER
  533. 240 IF SYSOP.NEXT THEN _
  534.        SUBROUTINE.PARAMETER = 3 : _
  535.        EXIT SUB
  536. '
  537. ' *****************************************************************************
  538. ' * WAIT FOR INCOMING CALLS                                                   *
  539. ' *****************************************************************************
  540. '
  541. 245 WHILE INP(MODEM.STATUS.REGISTER) < 128
  542.       CALL FINDFUNC
  543.       IF FUNCTION.KEY >0 THEN _
  544.      SUBROUTINE.PARAMETER = 6 : _
  545.      EXIT SUB
  546. 250   IF KEY.PRESSED$ = ESCAPE$ THEN _
  547.      SUBROUTINE.PARAMETER = 3 : _
  548.      EXIT SUB
  549. 260   IF RINGBACK.WAIT.STARTED! > 0 THEN _
  550.      CALL FINDTIME (TI!) : _
  551.      IF ABS(TI! - RINGBACK.WAIT.STARTED!) > 45 THEN _
  552.         RINGBACK.WAIT.STARTED! = 0 : _
  553.         RING.BACK.COUNT = 0 : _
  554.         RING.ANSWER = FALSE: _
  555.         IF (SNOOP AND RINGBACK) THEN _
  556.            PRINT "Ringback timeout";PAGING.PRINTER.SUPPORT$
  557. 265   CALL FINDTIME (TI!)
  558.       IF ABS(TI! - TCA!) > 120 THEN _
  559.      LOCATE ,,0 : _
  560.      CLS : _
  561.          C.L = 1 : _
  562.      CALL FINDTIME (TCA!)
  563. 266   IF (INP(MODEM.STATUS.REGISTER) AND &H40) > 0 AND _
  564.      REQUIRED.RINGS > 0 THEN _
  565.      GOTO 276
  566. 270 WEND
  567.     IF REQUIRED.RINGS = 0 THEN _
  568.        GOTO 321
  569. '
  570. ' *****************************************************************************
  571. ' * PREPARE TO ANSWER THIS CALL ON A SPECIFIED NUMBER OF RINGS (S0 = 254) OR  *
  572. ' * THE CALL AFTER THIS CALL ON A SPECIFIED NUMBER OF RINGS (S0 = 255) --     *
  573. ' * "RING BACK."                                                              *
  574. ' *****************************************************************************
  575. '
  576. 276 IF LOC(3) THEN _
  577.        X$ = INPUT$(LOC(3),3)
  578. 277 IF EC = 57 THEN _
  579.        LINE.STATUS = INP(LINE.STATUS.REGISTER) : _
  580.        EC = 0
  581.     IF PCJR THEN _
  582.        GOTO 320
  583.     A$ = MODEM.COUNT.RINGS.COMMAND$
  584.     CALL MODEMPUT (A$)
  585.     CALL DELAYIT (MODEM.COMMAND.DELAY.TIME)
  586. 290 X$ = INPUT$(LOC(3),3)
  587. 291 IF LEN(X$) = 0 THEN _
  588.        GOTO 310
  589. 292 X$=MID$(X$,INSTR(X$,"0"))
  590. 293 IF (NOT RING.ANSWER) AND (VAL(X$) < RING.BACK.COUNT) THEN _
  591.        RING.ANSWER = TRUE
  592. 300 RING.BACK.COUNT = VAL(X$)
  593.     Q = RING.BACK.COUNT + 1
  594.     IF (NOT RING.ANSWER) THEN _
  595.        Q = 0
  596. 305 IF SNOOP THEN _
  597.        PRINT TIME$ + " Ring " + STR$(Q);
  598. 310 IF (RING.BACK.COUNT+1 < REQUIRED.RINGS) OR _
  599.        (NOT RING.ANSWER) THEN _
  600.        GOTO 239
  601. 320 IF PCJR THEN _
  602.        A$ = CHR$(14) + _   ' PC-JR'S MODEM COMMAND IDENTIFIER
  603.         "T 0," + _     ' SET PC-JR'S MODEM TO TRANSPARENT MODE PERMANENTLY
  604.         "M" _          ' TELL THE PC-JR'S MODEM TO ANSWER IN DATA MODE
  605.        ELSE A$ = MODEM.ANSWER.COMMAND$
  606.     CALL MODEMPUT (A$)
  607. '
  608. ' *****************************************************************************
  609. ' *  TEST FOR CARRIER PRESENT                                                 *
  610. ' *****************************************************************************
  611. '
  612. 321 CALL FINDTIME (CONNECT.DELAY!)
  613.     CONNECT.DELAY! = CONNECT.DELAY! + 30
  614.     IF CONNECT.DELAY! > 86399 THEN _
  615.        CONNECT.DELAY! = 86399
  616.     MODEM.RESPONSE$ = ""
  617. 322 CALL FINDTIME (TI!)
  618. 323 SUBROUTINE.PARAMETER = -9
  619.     CALL CARRIER
  620.     IF SUBROUTINE.PARAMETER AND _
  621.        TI! < CONNECT.DELAY! THEN _
  622.        GOTO 322
  623.     IF SUBROUTINE.PARAMETER THEN _
  624.        SUBROUTINE.PARAMETER = 4 : _
  625.        EXIT SUB
  626.     CALL DELAYIT (3)
  627. 324 SUBROUTINE.PARAMETER = 0
  628.     MODEM.RESPONSE$ = MODEM.RESPONSE$ + INPUT$(LOC(3),3)
  629. 325 IF EC = 57 THEN _
  630.        LINE.STATUS = INP(LINE.STATUS.REGISTER) : _
  631.        EC = 0 : _
  632.        GOTO 323
  633.     IF SUBROUTINE.PARAMETER = 5 THEN _
  634.        EXIT SUB
  635.     CALL FINDTIME (TI!)
  636.     IF TI! > CONNECT.DELAY! THEN _
  637.        CALL UPDTCALR ("Connect timeout",1) : _
  638.        SUBROUTINE.PARAMETER = 4 : _
  639.        EXIT SUB
  640.     IF DUMB.MODEM THEN _
  641.        BAUD.TEST = VAL(MODEM.INIT.BAUD$) : _
  642.        GOTO 326
  643.     IF INSTR(MODEM.RESPONSE$,"CONNECT") THEN _
  644.        BAUD.TEST = VAL(MID$(MODEM.RESPONSE$,INSTR(MODEM.RESPONSE$,"CONNECT") + 8,4)) : _
  645.        GOTO 326
  646.     IF INSTR(MODEM.RESPONSE$,"ONLINE") THEN _
  647.        BAUD.TEST = VAL(MID$(MODEM.RESPONSE$,INSTR(MODEM.RESPONSE$,"ONLINE") + 7,4)) : _
  648.        GOTO 326
  649.     GOTO 324
  650. 326 IF INSTR(MODEM.RESPONSE$,"REL") OR _
  651.        INSTR(MODEM.RESPONSE$,"R C") OR _       (ERROR CONTROL)
  652.        INSTR(MODEM.RESPONSE$,"ARQ") OR _
  653.        INSTR(MODEM.RESPONSE$,"MNP") THEN _
  654.          RELIABLE.MODE = TRUE
  655.     IF BAUD.TEST = 0 OR BAUD.TEST = 300 THEN _
  656.        BAUD.TEST = 300 : _
  657.        BPS = -1 : _
  658.        BAUD.RATE.DIVISOR = &H180 + (11*(COMPUTER.TYPE = 2)) : _
  659.        GOTO 331
  660.     IF BAUD.TEST = 1200 THEN _
  661.        BPS = -3 : _
  662.        BAUD.RATE.DIVISOR = &H60 + (3*(COMPUTER.TYPE = 2)) : _
  663.        GOTO 331
  664.     IF BAUD.TEST = 2400 THEN _
  665.        BPS = -4 : _
  666.        BAUD.RATE.DIVISOR = &H30 + (1*(COMPUTER.TYPE = 2)) : _
  667.        GOTO 331
  668.     IF BAUD.TEST = 4800 OR BAUD.TEST = 9600 THEN _
  669.        BPS = -4-(BAUD.TEST /4800) : _
  670.        BAUD.RATE.DIVISOR = 12 * (BPS + 7) : _
  671.        GOTO 331
  672.     GOTO 324
  673. 331 CALL SETBAUD
  674.     SUBROUTINE.PARAMETER = 2
  675. 335 IF NOT RELIABLE.MODE THEN _
  676.        A = INSTR(TRANSFER.OPTIONS$,"I)") : _
  677.        IF A>0 THEN _
  678.           TRANSFER.OPTIONS$ = LEFT$(TRANSFER.OPTIONS$,A-1) + _
  679.                               MID$(TRANSFER.OPTIONS$,A+20)
  680.     END SUB
  681. ' $SUBTITLE: 'PASSWORD - verify User and Message passwords'
  682. ' $PAGE
  683. '
  684. '  SUBROUTINE NAME    -- PASSWORD
  685. '
  686. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  687. '                        SUBROUTINE.PARAMETER = 1  VERIFY USER PASSWORD
  688. '                        SUBROUTINE.PARAMETER = 2  VERIFY MESSAGE PASSWORD
  689. '                        SUBROUTINE.PARAMETER = 3  VERIFY MESSAGE PASSWORD
  690. '                        SUBROUTINE.PARAMETER = 4  VERIFY MESSAGE PASSWORD
  691. '                        SUBROUTINE.PARAMETER = 5  VERIFY MESSAGE PASSWORD
  692. '
  693. '  OUTPUT PARAMETERS  -- PASSWORD.FAILED           SET TO 0 IF PASSED
  694. '                                                  SET TO -1 IF FAILED
  695. '
  696. '  SUBROUTINE PURPOSE -- TO VERIFY USER AND MESSAGE PASSWORDS
  697. '
  698.     SUB PASSWORD STATIC
  699.     ON ERROR GOTO 65000
  700.     EC = 0
  701.     ON SUBROUTINE.PARAMETER GOTO 665,667,670,675,677
  702. 665 IF PASSWORD.SAVE$ = PASSWORD$ THEN _
  703.        PASSWORD.FAILED = 0 : _
  704.        EXIT SUB
  705. 667 ATTEMPTS = 0
  706. 670 ATTEMPTS = ATTEMPTS + 1
  707.     IF ATTEMPTS > ATTEMPTS.ALLOWED THEN _
  708.        PASSWORD.FAILED = TRUE : _
  709.        EXIT SUB
  710. 675 A$ = "Enter Password (dots echo)"
  711.     HIDDEN = TRUE
  712.     SUBROUTINE.PARAMETER = 1
  713.     CALL TGET
  714.     HIDDEN = FALSE
  715.     SUBROUTINE.PARAMETER = 5
  716.     CALL TPUT
  717.     Z$ = B$(1)
  718. 677 IF LEN(Z$) > 15 THEN _
  719.        GOTO 680
  720.     IF EC <> 0 THEN _
  721.        GOTO 670
  722.     CALL ALLCAPS (Z$)
  723.     Z$ = Z$ + SPACE$(15-LEN(Z$))
  724.     IF PASSWORD.SAVE$ = Z$ THEN _
  725.        PASSWORD.FAILED = 0 : _
  726.        EXIT SUB
  727. 680 IF MESSAGE.PASSWORD THEN _
  728.        CALL QTPUT("Wrong password entered",1)
  729.     GOTO 670
  730.     END SUB
  731. ' $SUBTITLE: 'TPUT -- RBBS-PC common routine to write to comm. port'
  732. ' $PAGE
  733. '
  734. '  SUBROUTINE NAME    -- TPUT (TERMINAL PUT)
  735. '
  736. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  737. '                                A$                 STRING TO WRITE TO THE
  738. '                                                   COMMUNICATIONS PORT
  739. '                         SUBROUTINE.PARAMETER = 1  SKIP A LINE BEFORE WRITING
  740. '                                                   TO THE COMMUNICATIONS PORT
  741. '                         SUBROUTINE.PARAMETER = 2  SKIP A LINE BEFORE WRITING
  742. '                                                   TO THE COMMUNICATIONS PORT
  743. '                                                   AND THEN SKIP TWO LINES
  744. '                                                   AFTER WRITING TO THE COMM-
  745. '                                                   UNICATIONS PORT
  746. '                         SUBROUTINE.PARAMETER = 3  WRITE TO THE COMMUNICATIONS
  747. '                                                   PORT AND THEN SKIP TWO
  748. '                                                   LINES
  749. '                         SUBROUTINE.PARAMETER = 4  WRITE TO THE COMMUNICATIONS
  750. '                                                   PORT WITHOUT A CR/LF
  751. '                         SUBROUTINE.PARAMETER = 5  WRITE TO THE COMMUNICATIONS
  752. '                                                   PORT WITH A CR/LF
  753. '                         SUBROUTINE.PARAMETER = 6  RESET EVERYTHING FOR INPUT
  754. '                                                   STRING
  755. '                         SUBROUTINE.PARAMETER = 7  RE-ENTRY AFTER HANDLING A
  756. '                                                   FUNCTION KEY
  757. '
  758. '  OUTPUT PARAMETERS  --  SUBROUTINE.PARAMETER = -1 CARRIER HAS BEEN DROPPED
  759. '                         FUNCTION.KEY        <>  0 FUNCTION KEY PRESSED
  760. '
  761. '  SUBROUTINE PURPOSE --  COMMON OUTPUT ROUTINE FOR RBBS-PC TO THE
  762. '                         COMMUNICATIONS PORT (TERMINAL PUT)
  763.       SUB TPUT STATIC
  764.       ON ERROR GOTO 65000
  765.       HALT.IT = 0
  766.       IF SUBROUTINE.PARAMETER <> 7 THEN _
  767.          PARM = SUBROUTINE.PARAMETER
  768.       ON SUBROUTINE.PARAMETER GOTO 1398,1399,1400,1403,1405,1450,1411
  769. '
  770. ' *****************************************************************************
  771. ' *  COMMON OUTPUT ROUTINE                                                    *
  772. ' *****************************************************************************
  773. '
  774. 1398 CALL SKIPLINE (1)
  775.      GOTO 1405
  776. 1399 CALL SKIPLINE (1)
  777. 1400 CR = 1
  778. 1403 CR = CR + 1
  779. 1405 RET = FALSE
  780.      IF NOT STOP.INTERRUPTS OR CM THEN _
  781.         GOTO 1435
  782. 1410 CALL FINDFUNC
  783.      IF FUNCTION.KEY <> 0 THEN _
  784.         EXIT SUB
  785. 1411 Y$ = KEY.PRESSED$
  786.      SUBROUTINE.PARAMETER = PARM
  787.      IF LOCAL.USER THEN _
  788.         GOTO 1430
  789.      IF EOF(3) THEN _
  790.         CALL CARRIER : _
  791.         IF SUBROUTINE.PARAMETER = -1 THEN _
  792.            EXIT SUB _
  793.         ELSE GOTO 1430
  794. 1420 Y$ = INPUT$(1,3)
  795. 1421 IF EC = 57 THEN _
  796.         LINE.STATUS = INP(LINE.STATUS.REGISTER) : _
  797.         EC = 0 : _
  798.         GOTO 1420
  799. 1425 IF SUBROUTINE.PARAMETER = -1 THEN _
  800.         EXIT SUB
  801.      IF Y$ = XOFF$ THEN _
  802.         WHILE EOF(3) : _
  803.            GOSUB 1473 : _
  804.            CALL CARRIER : _
  805.            IF SUBROUTINE.PARAMETER = -1 THEN _
  806.               EXIT SUB _
  807.      ELSE WEND : _
  808.           GOTO 1420
  809. 1430 IF (Y$ = CHR$(11) OR _          ' INTERRUPT OUTPUT IF:
  810.          Y$ = CANCEL$ OR _           ' CTRL / K
  811.          Y$ = XOFF$) AND _           ' CTRL / X
  812.         STOP.INTERRUPTS THEN _       ' CTRL / S
  813.         GOTO 1475
  814. 1435 IF NOT SNOOP THEN _
  815.         GOTO 1437
  816.      LOCATE ,,1
  817.      IF COLOR.SUPPORT AND A$ <> "" THEN _
  818.         CALL ANSI(A$,C.C,C.L) : _
  819.         LOCATE C.C,C.L : _
  820.         GOTO 1437
  821.      CALL PRTCRLF (A$)
  822. 1437 IF LOCAL.USER THEN _
  823.         GOTO 1450
  824.      IF UPPER.CASE THEN _
  825.         CALL ALLCAPS (A$)
  826.      IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
  827.         PRINT #3,A$;
  828. 1450 IF CR <> 1 THEN _
  829.         CALL SKIPLINE (1) _
  830.      ELSE IF CR > 1 THEN _
  831.              CALL SKIPLINE (1)
  832. 1470 Y$ = ""
  833.      A$ = Y$
  834.      CR = 0
  835.      IF HALT.IT = 0 THEN _
  836.         EXIT SUB
  837.      STOP.INTERRUPTS = RET
  838.      RET = TRUE
  839.      NON.STOP = FALSE
  840.      EXIT SUB
  841. 1473 IF MULTI.LINK.PRESENT > 0 THEN _
  842.         AX = &H200 : _
  843.         BX = &H0 : _
  844.         CALL RBBSML(AX,BX)
  845.      RETURN
  846. 1475 CR = 2
  847.      RET = STOP.INTERRUPTS
  848.      STOP.INTERRUPTS = FALSE
  849.      HALT.IT = 1
  850.      GOTO 1410
  851.      END SUB
  852. ' $SUBTITLE: 'OPENRSEQ  - subroutine open sequential file randomly'
  853. ' $PAGE
  854. '
  855. '  SUBROUTINE NAME    -- OPENRSEQ
  856. '
  857. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  858. '                        FILNAME$      NAME OF SEQUENTIAL FILE TO OPEN AS #2
  859. '
  860. '  OUTPUT PARAMETERS  -- NUM.RECS      NUMBER OF 128-BYTE RECORDS IN THE FILE
  861. '                        LEN.LAST.REC  NUMBER OF BYTES IN THE LAST RECORD (IT
  862. '                                      MAY BE LESS THAN OR EQUAL TO 128).
  863. '
  864. '  SUBROUTINE PURPOSE -- SUBROUTINE TO OPEN A SEQUENTIAL FILE AS FILE # 2 AND
  865. '                        READ IT RANDOMLY.
  866. '
  867.      SUB OPENRSEQ (FILNAME$,NUM.RECS,LEN.LAST.REC) STATIC
  868. 1479 ON ERROR GOTO 65000
  869.      CLOSE 2
  870. 1480 EC = 0
  871. 1481 IF SHARE.IT THEN _
  872.         OPEN FILNAME$ FOR RANDOM SHARED AS #2 LEN=BUFFER.SIZE _
  873.      ELSE OPEN "R",2,FILNAME$,BUFFER.SIZE
  874.      IF EC = 52 THEN _
  875.         GOTO 1480
  876.      I# = LOF(2)
  877.      NUM.RECS = FIX(I#/BUFFER.SIZE)
  878.      LEN.LAST.REC = I# - NUM.RECS*BUFFER.SIZE
  879.      IF LEN.LAST.REC > 0 THEN _
  880.         NUM.RECS = NUM.RECS + 1 _
  881.      ELSE LEN.LAST.REC = BUFFER.SIZE
  882.   END SUB
  883. ' $SUBTITLE: 'TGET -- RBBS-PC common routine to ask a user a question'
  884. ' $PAGE
  885. '
  886. '  SUBROUTINE NAME    -- TGET
  887. '
  888. '  INPUT PARAMETERS   --    PARAMETER                   MEANING
  889. '                         SUBROUTINE.PARAMETER = 1  STANDARD ENTRY
  890. '                         SUBROUTINE.PARAMETER = 2  ENTRY AFTER A FUNCTION KEY
  891. '                                                   HAS BEEN HANDLED
  892. '                                A$                 STRING TO WRITE TO THE
  893. '                                                   COMMUNICATIONS PORT
  894. '                         HIDDEN                    IF THIS IS TRUE THEN ECHO
  895. '                                                   '.' INSTEAD OF ACTUAL
  896. '                                                   CHARACTER ENTERED.
  897. '
  898. '  OUTPUT PARAMETERS  --  SUBROUTINE.PARAMETER = -1 CARRIER HAS BEEN DROPPED
  899. '                         B$                        STRING THAT WAS ENTERED
  900. '                         Q                         NUMBER OF PARAMETERES THAT
  901. '                                                   WERE ENTERED WHICH WHERE
  902. '                                                   SEPARATED BY A SEMICOLON
  903. '                         B$()                      STRING MATRIX WITH EACH
  904. '                                                   ITEM CONTAIN THE STRING
  905. '                                                   THAT WAS ENTERED BETWEEN
  906. '                                                   SEMICOLONS.
  907. '                         FUNCTION.KEY        <>  0 FUNCTION KEY PRESSED
  908. '                         YES                       REPLY IS "Y" OR "YES"
  909. '                         NO                        REPLY IS "N" OR "NO"
  910. '                         NON.STOP                  REPLY IS "NS" OR "ns"
  911. '                         KILL.MESSAGE              REPLY IS "K"
  912. '                         REPLY                     REPLY IS "RE"
  913. '
  914. '  SUBROUTINE PURPOSE --  COMMON ROUTINE TO ASK A USER A QUESTION
  915. '
  916.       SUB TGET STATIC
  917.       ON ERROR GOTO 65000
  918.       ON SUBROUTINE.PARAMETER GOTO 1500,1526
  919. '
  920. ' *****************************************************************************
  921. ' *  COMMON INPUT ROUTINE                                                     *
  922. ' *****************************************************************************
  923. '
  924. 1500 CALL CARRIER
  925.      IF SUBROUTINE.PARAMETER = -1 THEN _
  926.         EXIT SUB
  927.      LINES.PRINTED = 0
  928.      TOA! = FRE("A")
  929.      CALL FINDTIME (AUTO.LOGOFF!)
  930.      AUTO.LOGOFF! = AUTO.LOGOFF! + WAIT.BEFORE.DISCONNECT
  931.      A = 0
  932.      B = 0
  933.      C = 0
  934.      Q = 1
  935.      EOL = FALSE
  936.      YES = FALSE
  937.      B$ = ""
  938.      NO = FALSE
  939.      A$ = A$ + "? "
  940.      SUBROUTINE.PARAMETER = 4
  941.      CALL TPUT
  942.      IF SUBROUTINE.PARAMETER = -1 OR FUNCTION.KEY <> 0 THEN _
  943.         EXIT SUB
  944.      IF NOT LOCAL.USER THEN 1523
  945.         LINE INPUT "",B$
  946.         IF NO.ADVANCE THEN _
  947.            NO.ADVANCE = FALSE : _
  948.            LOCATE CSRLIN-1,1 : _
  949.            CALL WIPELINE (79)
  950.         GOTO 1575
  951. 1523 IF PROMPT.BELL AND INP(MODEM.STATUS.REGISTER) >127 THEN _
  952.         PRINT #3,CHR$(7);
  953. 1525 IF NOT EOF(3) THEN _
  954.         GOTO 1528
  955.      CALL CARRIER
  956.      IF SUBROUTINE.PARAMETER = -1 THEN _
  957.         EXIT SUB
  958.      CALL FINDTIME (TI!)
  959.      IF TI! > AUTO.LOGOFF! THEN _
  960.         CALL UPDTCALR ("Sleep disconnect",1) : _
  961.         SUBROUTINE.PARAMETER = -1 : _
  962.         EXIT SUB
  963.      CALL FINDFUNC
  964.      IF FUNCTION.KEY <> 0 THEN _
  965.         EXIT SUB
  966. 1526 Y$ = KEY.PRESSED$
  967.      IF Y$ <> "" THEN _
  968.         GOTO 1545
  969.      GOTO 1525
  970. 1528 CALL CARRIER
  971.      IF SUBROUTINE.PARAMETER = -1 THEN _
  972.         EXIT SUB
  973. 1540 Y$ = INPUT$(1,3)
  974. 1541 IF EC = 57 THEN _
  975.         LINE.STATUS = INP(LINE.STATUS.REGISTER) : _
  976.         EC = 0 : _
  977.         GOTO 1540
  978.      IF SUBROUTINE.PARAMETER = -1 THEN _
  979.         EXIT SUB
  980.      IF TEST.PARITY THEN _
  981.         GOTO 1542
  982.      IF Y$ = CHR$(127) THEN _
  983.         GOTO 1635
  984.      GOTO 1545
  985. 1542 IF ASC(Y$) = 141 THEN _
  986.         OUT LINE.CONTROL.REGISTER,&H1A : _
  987.         EIGHT.BIT = FALSE : _
  988.         TEST.PARITY = FALSE : _
  989.         GR = FALSE
  990.      Y$ = CHR$(ASC(Y$) AND 127)
  991. 1545 IF INSTR(LINEEDIT.CHK$,Y$) > 5 _
  992.         GOTO 1635
  993.      IF Y$ < " " AND Y$ <> CARRIAGE.RETURN$ THEN _
  994.         GOTO 1525
  995.      IF Y$ = "^" THEN _
  996.         GOTO 1525
  997.      IF Y$ = CARRIAGE.RETURN$ THEN _
  998.         IF NO.ADVANCE THEN _
  999.            NO.ADVANCE = FALSE : _
  1000.            GOTO 1575_
  1001.         ELSE_
  1002.            GOSUB 1550 : _
  1003.            GOTO 1570_
  1004.      ELSE_
  1005.         GOSUB 1550
  1006.      IF LEN(B$) >= 254 THEN _
  1007.         A$ = "Input too long!" : _
  1008.         SUBROUTINE.PARAMETER = 5 : _
  1009.         CALL TPUT : _
  1010.         IF SUBROUTINE.PARAMETER = -1 OR FUNCTION.KEY <> 0 THEN _
  1011.            EXIT SUB _
  1012.         ELSE GOTO 1500
  1013.      B$ = B$ + Y$
  1014.      GOTO 1525
  1015. 1550 IF SNOOP THEN _
  1016.         PRINT Y$;
  1017.      IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
  1018.         IF HIDDEN THEN _
  1019.            PRINT #3,"."; _
  1020.         ELSE _
  1021.            PRINT #3,Y$;
  1022.      RETURN
  1023. 1570 IF LINE.FEEDS AND INP(MODEM.STATUS.REGISTER) > 127 THEN _
  1024.         PRINT #3,LINE.FEED$;
  1025. 1575 A = INSTR(B$,";")
  1026.      IF A < 2 THEN _
  1027.         GOTO 1620
  1028.      B$(1) = LEFT$(B$,A-1)
  1029.      A = A + 1
  1030. 1585 B = INSTR(A,B$,";")
  1031.      C = B-A
  1032.      IF C < 1 THEN _
  1033.         EOL = TRUE : _
  1034.         C = 128
  1035.      DF$ = MID$(B$,A,C)
  1036.      IF DF$ <> "" THEN _
  1037.         Q = Q + 1 : _
  1038.         B$(Q) = DF$
  1039.      IF NOT EOL AND Q < 10 THEN _
  1040.         A = B + 1 : _
  1041.         GOTO 1585
  1042.      IF LEN(B$) > 4000 THEN _
  1043.         A$ = "Try again, " + FIRST.NAME$ : _
  1044.         SUBROUTINE.PARAMETER = 5 : _
  1045.         CALL TPUT : _
  1046.         IF SUBROUTINE.PARAMETER = -1 OR FUNCTION.KEY <> 0 THEN _
  1047.            EXIT SUB _
  1048.         ELSE GOTO 1500
  1049.      GOTO 1625
  1050. 1620 B$(1) = B$
  1051.      Q = 1
  1052.      IF B$ = "" THEN _
  1053.         Q = 0 : _
  1054.         EXIT SUB
  1055. 1625 CALL ALLCAPS (B$)
  1056.      IF LEN(B$) < 4 THEN _
  1057.         X$ = LEFT$(B$,3): _
  1058.         IF X$ = "Y" OR X$ = "YES" THEN _
  1059.            YES = TRUE _
  1060.         ELSE IF X$ = "N" OR X$ = "NO" THEN _
  1061.                 NO = TRUE
  1062.      IF B$(Q) = "NS" OR B$(Q) = "ns" THEN _
  1063.         NON.STOP = TRUE : _
  1064.         B$(Q) = "" : _
  1065.         IF Q > 1 THEN _
  1066.            Q = Q-1
  1067.      IF B$ = "RE" THEN _
  1068.         REPLY = TRUE : _
  1069.         EXIT SUB
  1070.      IF B$ = "K" THEN _
  1071.         KILL.MESSAGE = TRUE
  1072.      EXIT SUB
  1073. 1635 IF LEN(B$) = 0 THEN _
  1074.         GOTO 1525
  1075.      B$ = LEFT$(B$,LEN(B$)-1)
  1076.      IF SNOOP THEN _
  1077.         PRINT BACK.ARROW$;
  1078.      IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
  1079.         PRINT #3,BACKSPACE$;
  1080.      GOTO 1525
  1081.      END SUB
  1082. ' $SUBTITLE: 'LINEEDIT  - subroutine to produce edited line'
  1083. ' $PAGE
  1084. '
  1085. '  SUBROUTINE NAME    -- LINEEDIT
  1086. '
  1087. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  1088. '                        BACK.ARROW$
  1089. '                        BACKSPACE$
  1090. '                        CARRIAGE.RETURN$
  1091. '                        LINE.FEED$
  1092. '                        LINEMES$          BUFFER SPACE TO USE FOR HOLDING LINE
  1093. '                        LOCAL.USER
  1094. '                        MAX.LEN           MAXIMUM LENGTH OF STRING TO INPUT
  1095. '                        MESSAGE.LINE      WHERE IN A$() TO PUT THE EDITED LINE
  1096. '                        RIGHT.MARGIN
  1097. '                        SNOOP
  1098. '                        STOP.INTERRUPTS
  1099. '                        WAIT.EXPIRED
  1100. '
  1101. '  OUTPUT PARAMETERS  -- A$(MESSAGE.LINE)  EDITED LINE
  1102. '
  1103. '  SUBROUTINE PURPOSE -- SUBROUTINE TO EDIT A LINE QUICKLY USING A MINIMUM OF
  1104. '                        STRING SPACE.
  1105. '
  1106.      SUB LINEEDIT (MESSAGE.LINE,MAX.LEN) STATIC
  1107. 3700 LSET LINEMES$ = A$(MESSAGE.LINE)
  1108.      COL = LEN(A$(MESSAGE.LINE))
  1109.      STOP.INTERRUPTS = FALSE
  1110.      XXX = MAX.LEN - 3
  1111.      WAIT.EXPIRED = FALSE
  1112. 3720 COL = COL + 1
  1113.      CALL FINDTIME (TI!)
  1114.      AUTO.LOGOFF! = TI! + WAIT.BEFORE.DISCONNECT
  1115. 3730 CALL FINDFUNC
  1116.      IF FUNCTION.KEY <> 0 THEN _
  1117.         EXIT SUB
  1118.      X$ = KEY.PRESSED$
  1119.      IF X$ = "" THEN _
  1120.         IF LOCAL.USER THEN _
  1121.            GOTO 3730 _
  1122.         ELSE _
  1123.            GOTO 3732
  1124.      IF X$ = ESCAPE$ THEN _
  1125.         KEY.PRESSED$ = X$: _
  1126.         EXIT SUB
  1127.      Z = INSTR(LINEEDIT.CHK$,X$)
  1128.      IF Z < 1 THEN_
  1129.         GOTO 3750_
  1130.      ELSE IF Z > 4 THEN _
  1131.              GOTO 3870
  1132.      IF LOCAL.USER THEN _
  1133.         GOTO 3730
  1134. 3732 IF NOT EOF(3) THEN _
  1135.         GOTO 3736
  1136.      CALL FINDTIME (TI!)
  1137.      IF TI! > AUTO.LOGOFF! THEN _
  1138.         WAIT.EXPIRED = TRUE : _
  1139.         EXIT SUB
  1140. 3733 CALL CARRIER
  1141.      IF SUBROUTINE.PARAMETER THEN _
  1142.         EXIT SUB
  1143.      GOTO 3730
  1144. 3736 AUTO.LOGOFF! = TI! + WAIT.BEFORE.DISCONNECT
  1145. 3737 X$ = INPUT$(1,3)
  1146. 3740 ON INSTR(LINEEDIT.CHK$,X$) GOTO 3730,3730,3730,3730,3870,3870,3870,3870,3870
  1147. 3750 A$ = X$
  1148.      SUBROUTINE.PARAMETER = 4
  1149.      CALL TPUT
  1150.      IF X$ = CARRIAGE.RETURN$ THEN _
  1151.         COL = COL - 1 : _
  1152.         GOTO 3850
  1153. 3770 IF COL > XXX THEN _
  1154.         IF X$ = " " THEN _
  1155.            SUBROUTINE.PARAMETER = 5: _
  1156.            CALL TPUT : _
  1157.            GOTO 3860
  1158. 3780 MID$(LINEMES$,COL) = X$
  1159.      IF COL < MAX.LEN THEN _
  1160.         GOTO 3720
  1161.      Z = COL
  1162. 3800 IF Z < 1 THEN _
  1163.         Z = COL-1 : _
  1164.         GOTO 3820
  1165.      IF MID$(LINEMES$,Z,1) = " " THEN _
  1166.         GOTO 3820
  1167.      Z = Z - 1
  1168.      GOTO 3800
  1169. 3820 COL = MAX.LEN - Z
  1170.      IF SNOOP THEN _
  1171.         LOCATE ,POS(0)-COL: _
  1172.         PRINT STRING$(COL,32);
  1173. 3830 CALL CARRIER
  1174.      IF NOT LOCAL.USER AND SUBROUTINE.PARAMETER = 0 THEN _
  1175.         PRINT #3,STRING$(COL,8) + STRING$(COL,32);
  1176. 3840 A$(MESSAGE.LINE) = LEFT$(LINEMES$,Z)
  1177.      A$(MESSAGE.LINE + 1) = MID$(LINEMES$,Z+1,COL)
  1178.      SUBROUTINE.PARAMETER = 5
  1179.      CALL TPUT
  1180.      EXIT SUB
  1181. 3850 CALL CARRIER
  1182.      IF NOT LOCAL.USER AND LINE.FEEDS AND _
  1183.         SUBROUTINE.PARAMETER = 0 THEN _
  1184.         PRINT #3,LINE.FEED$;
  1185. 3860 A$(MESSAGE.LINE) = LEFT$(LINEMES$,COL)
  1186.      EXIT SUB
  1187. 3870 IF COL = 1 THEN _
  1188.         GOTO 3730
  1189.      COL = COL-2
  1190. 3880 IF SNOOP THEN _
  1191.         PRINT BACK.ARROW$;
  1192. 3885 CALL CARRIER
  1193.      IF NOT LOCAL.USER AND SUBROUTINE.PARAMETER = 0 THEN _
  1194.         PRINT #3,BACKSPACE$;
  1195. 3890 GOTO 3720
  1196.      END SUB
  1197.  
  1198. ' $SUBTITLE: 'BAUD450 -- Changes 300 baud to 450'
  1199. ' $PAGE
  1200. '  SUBROUTINE NAME    -- BAUD450
  1201. '
  1202. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  1203. '                        BPS
  1204. '
  1205. '  OUTPUT PARAMETERS  -- BPS
  1206. '
  1207. '  SUBROUTINE PURPOSE -- ALLOW 300 BAUD MODEMS TO BUMP UP TO 450 BAUD
  1208. '
  1209.      SUB BAUD450 STATIC
  1210.      ON ERROR GOTO 65000
  1211.      IF BPS <> -1 THEN _
  1212.         CALL QTPUT ("Sorry, only 300 baud can change speed",1) : _
  1213.         EXIT SUB
  1214. 5507 A$ = "Change to 450 baud (Y,[N])"
  1215.      SUBROUTINE.PARAMETER = 1
  1216.      CALL TGET
  1217.      IF NOT YES THEN _
  1218.         EXIT SUB
  1219. 5510 A$ = "Change. Then press [ENTER] until I respond"
  1220.      SUBROUTINE.PARAMETER = 9
  1221.      CALL TGET
  1222.      CALL DELAYIT (9)
  1223.      C = 0
  1224.      BAUD.RATE.DIVISOR = &H100
  1225.      CALL SETBAUD
  1226. 5530 C = C + 1
  1227.      CALL CARRIER
  1228.      IF SUBROUTINE.PARAMETER THEN _
  1229.         EXIT SUB
  1230.      IF C = 20 THEN _
  1231.         CALL UPDTCALR ("Baud change failed",1) : _
  1232.         EXIT SUB
  1233.      CALL DELAYIT (1)
  1234. 5535 IF EOF(3) THEN _
  1235.         GOTO 5530
  1236. 5536 IF ASC(INPUT$(1,3)) = 13 THEN _
  1237.         GOTO 5540
  1238. 5537 GOTO 5530
  1239. 5540 A$ = "Changed to 450 baud"
  1240.      CALL QTPUT (A$,1)
  1241.      CALL UPDTCALR (A$,1)
  1242.      BPS = -2
  1243.      END SUB
  1244. ' $SUBTITLE: 'OPENUSER - subroutine to open the users file as #5'
  1245. ' $PAGE
  1246. '
  1247. '  SUBROUTINE NAME    -- OPENUSER
  1248. '
  1249. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1250. '                        SHARE.IT
  1251. '
  1252. '  OUTPUT PARAMETERS  -- ACTIVE.USER.FILE$
  1253. '                        CITY.STATE$
  1254. '                        ELAPSED.TIME$
  1255. '                        LAST.DATE.TIME.ON$
  1256. '                        LIST.NEW.DATE$
  1257. '                        MACHINE.TYPE$
  1258. '                        PASSWORD$
  1259. '                        SECURITY.LEVEL$
  1260. '                        USER.DOWNLOADS$
  1261. '                        USER.NAME$
  1262. '                        USER.OPTIONS$
  1263. '                        USER.RECORD$
  1264. '                        USER.UPLOADS$
  1265. '
  1266. '  SUBROUTINE PURPOSE -- OPEN THE USER FILE AS FILE # 5
  1267. '
  1268.       SUB OPENUSER STATIC
  1269.       ON ERROR GOTO 65000
  1270. '
  1271. ' *****************************************************************************
  1272. ' * OPEN AND DEFINE USER FILE RECORD VARIABLES                                *
  1273. ' *****************************************************************************
  1274. '
  1275. 9400 CLOSE 5
  1276.      IF SHARE.IT THEN _
  1277.         OPEN ACTIVE.USER.FILE$ FOR RANDOM SHARED AS #5 LEN=128 _
  1278.      ELSE OPEN "R",5,ACTIVE.USER.FILE$,128
  1279.      FIELD 5,31 AS USER.NAME$, _
  1280.              15 AS PASSWORD$, _
  1281.               2 AS SECURITY.LEVEL$, _
  1282.              14 AS USER.OPTIONS$,  _
  1283.              24 AS CITY.STATE$, _
  1284.              19 AS MACHINE.TYPE$, _
  1285.              14 AS LAST.DATE.TIME.ON$, _
  1286.               3 AS LIST.NEW.DATE$, _
  1287.               2 AS USER.DOWNLOADS$, _
  1288.               2 AS USER.UPLOADS$, _
  1289.               2 AS ELAPSED.TIME$
  1290.      FIELD 5,128 AS USER.RECORD$
  1291.      END SUB
  1292. ' $SUBTITLE: 'FINDUSER - subroutine to search users file for a name'
  1293. ' $PAGE
  1294. '
  1295. '  SUBROUTINE NAME    -- FINDUSER
  1296. '
  1297. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1298. '                        HASH.TO.LOOK.FOR$    STRING TO SEARCH FOR IN USERS
  1299. '                        INDIV.TO.LOOK.FOR$   STRING TO USE TO INDIVIDUATE
  1300. '                                             USERS WITH SAME HASH
  1301. '                        START.HASH.POS       WHERE HASH FIELD STARTS IN THE
  1302. '                                             "USERS" FILE
  1303. '                        LEN.HASH.FIELD       LENGTH OF THE HASH FIELD
  1304. '                        START.INDIV.POS      WHERE THE FIELD TO DISTINGUISH
  1305. '                                             AMONG USERS (I.E. WITH THE SAME
  1306. '                                             NAME) STARTS IN THE "USERS" FILE
  1307. '                                             (SET TO 0 IF NONE TO BE USED)
  1308. '                        LEN.INDIV.FIELD      LENGTH OF FIELD TO DISTINGUISH
  1309. '                                             AMONG USERS
  1310. '                        MAX.POSITION         HIGHEST RECORD TO SEARCH OR USE
  1311. '
  1312. '  NOTE: THIS SUBROUTINE ASSUMES THE "USERS" FILE IS OPEN AS FILE 2.
  1313. '
  1314. '  OUTPUT PARAMETERS  -- WHETHER.FOUND        SET TO "TRUE" IF USER WAS FOUND
  1315. '                                             OTHERWISE IT IS "FALSE"
  1316. '                        POS.TO.USE           NUMBER OF THE "USERS" RECORD THAT
  1317. '                                             BELONGS TO THE USER (IF FOUND) OR
  1318. '                                             TO USE FOR THE USER (IF THE USER
  1319. '                                             WASN'T FOUND)
  1320. '                        POS.TO.RECLAIM       SET TO 0 IF THE RECORD NUMBER
  1321. '                                             SELECTED FOR THIS USER HAS NEVER
  1322. '                                             BEEN USED.
  1323. '
  1324. '  SUBROUTINE PURPOSE -- TO SEARCH THE "USERS" FILE AND DETERMINE THE RECORD
  1325. '                        NUMBER TO USE FOR THE CALLER IN THE "USERS" FILE.
  1326. '
  1327.       SUB FINDUSER (HASH.TO.LOOK.FOR$,INDIV.TO.LOOK.FOR$,START.HASH.POS,_
  1328.                     LEN.HASH.FIELD,START.INDIV.POS,LEN.INDIV.FIELD,_
  1329.                     MAX.POSITION,WHETHER.FOUND,_
  1330.                     POS.TO.USE,POS.TO.RECLAIM) STATIC
  1331.       ON ERROR GOTO 65000
  1332.       EC = 0
  1333.       WHETHER.FOUND = 0
  1334.       IF HASH.TO.LOOK.FOR$ = SPACE$(LEN(HASH.TO.LOOK.FOR$)) THEN _
  1335.          EXIT SUB
  1336.       EMPTY.REC$ = SPACE$(LEN.HASH.FIELD)
  1337.       EMPTY.INDIV$ = SPACE$(LEN.INDIV.FIELD)
  1338.       NEWUSER$ = LEFT$("NEWUSER  ",LEN.HASH.FIELD+2)
  1339.       FIELD 5, 128 AS FILLER$
  1340.       X$ = HASH.TO.LOOK.FOR$ + SPACE$(LEN.HASH.FIELD-LEN(HASH.TO.LOOK.FOR$))
  1341.       CALL HASHRBBS (HASH.TO.LOOK.FOR$,MAX.POSITION,POS.TO.USE,DF)
  1342.       Y$ = INDIV.TO.LOOK.FOR$ + SPACE$(LEN.INDIV.FIELD-LEN(INDIV.TO.LOOK.FOR$))
  1343.       POS.TO.RECLAIM = 0
  1344. 12610 GET 5,POS.TO.USE
  1345.       IF EC > 0 THEN _
  1346.          EC = 0 : _
  1347.          IF EC = 63 THEN _
  1348.             GOTO 12621 _
  1349.          ELSE GOTO 12620
  1350.       HASH.VALUE$ = MID$(FILLER$,START.HASH.POS,LEN.HASH.FIELD)
  1351.       IF X$ = HASH.VALUE$ THEN _
  1352.          IF START.INDIV.POS < 1 THEN _
  1353.            WHETHER.FOUND = TRUE : _
  1354.            GOTO 12622 _
  1355.          ELSE INDIV.VALUE$ = MID$(FILLER$,START.INDIV.POS,LEN.INDIV.FIELD):_
  1356.               IF Y$ = INDIV.VALUE$ OR INDIV.VALUE$ = EMPTY.INDIV$ THEN _
  1357.                  WHETHER.FOUND = TRUE : _
  1358.                  GOTO 12622
  1359.       IF HASH.VALUE$ = EMPTY.REC$ THEN _
  1360.               POS.TO.USE = POS.TO.RECLAIM-(POS.TO.RECLAIM = 0)*POS.TO.USE : _
  1361.               WHETHER.FOUND = FALSE : _
  1362.               GOTO 12622
  1363.       IF ASC(HASH.VALUE$) = 0 OR INSTR(HASH.VALUE$,NEWUSER$) = 1 THEN _
  1364.          IF POS.TO.RECLAIM = 0 THEN _
  1365.             POS.TO.RECLAIM = POS.TO.USE
  1366. 12620 POS.TO.USE = POS.TO.USE + DF
  1367.       IF POS.TO.USE > MAX.POSITION-1 THEN _
  1368.          POS.TO.USE = POS.TO.USE-MAX.POSITION
  1369.       GOTO 12610
  1370. 12621 IF POS.TO.RECLAIM = 0 THEN _
  1371.          POS.TO.RECLAIM = POS.TO.USE
  1372.       GOTO 12620
  1373. 12622 END SUB
  1374. ' $SUBTITLE: 'UPDTCALR - subroutine to write to CALLERS file'
  1375. ' $PAGE
  1376. '
  1377. '  SUBROUTINE NAME    -- UPDTCALR
  1378. '
  1379. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1380. '                        ERRMES$                   MESSAGE TO GO IN CALLER LOG
  1381. '                        EXT.LOG              = 1  CHECK FOR EXTENDED LOGGING
  1382. '                                                  BEFORE UPDATING.
  1383. '                                             = 2  UPDATE CALLER LOG WITH Z$
  1384. '
  1385. '  OUTPUT PARAMETERS  -- CURRENT.DATE$           CURRENT DATE (MM-DD-YY)
  1386. '                        TIM$                    CURRENT TIME (I.E. 1:13 PM)
  1387. '                        TIME.LOGGEND.ON$        TIME USER LOGGED ON (HH:MM:SS)
  1388. '
  1389. '  SUBROUTINE PURPOSE -- TO UPDATE THE CALLER'S FILE AND/OR PRINT ON THE
  1390. '                        LOCAL PRINTER IF IT IS ENABLED
  1391. '
  1392.       SUB UPDTCALR (ERRMES$,EXT.LOG) STATIC
  1393.       ON ERROR GOTO 65000
  1394.       FIELD 4, 64 AS CALLERS.RECORD$
  1395.       LSET CALLERS.RECORD$ = ERRMES$
  1396.       ON EXT.LOG GOTO 13665,13670
  1397. '
  1398. ' *****************************************************************************
  1399. ' * EXTENDED LOGGING ENTRY                                                    *
  1400. ' *****************************************************************************
  1401. '
  1402. 13665 IF NOT EXTENDED.LOGGING THEN _
  1403.          EXIT SUB
  1404.       SUBROUTINE.PARAMETER = 2
  1405.       A = INSTR(CALLERS.RECORD$,"  ")+1
  1406.       IF A>1 THEN _
  1407.          CALL AMORPM:_
  1408.          MID$(CALLERS.RECORD$,A) = " at " + TIM$
  1409. '
  1410. ' *****************************************************************************
  1411. ' * UPDATE CALLERS FILE WITH USER ACTIVITY                                    *
  1412. ' *****************************************************************************
  1413. '
  1414. 13670 LSET CALLERS.RECORD$ = SPACE$(5) + CALLERS.RECORD$
  1415.       CALL PRINTIT (CALLERS.RECORD$)
  1416.       IF LOCAL.USER AND PRINTER THEN _
  1417.          EXIT SUB
  1418.       CALLERS.FILE.INDEX = CALLERS.FILE.INDEX + 1
  1419.       PUT 4,CALLERS.FILE.INDEX
  1420.       END SUB
  1421. ' $SUBTITLE: 'PRINTIT - subroutine to print on the local PC's printer'
  1422. ' $PAGE
  1423. '
  1424. '  SUBROUTINE NAME    -- PRINTIT
  1425. '
  1426. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1427. '                             STRNG$             STRING TO WRITE TO THE PRINTER
  1428. '
  1429. '  OUTPUT PARAMETERS  -- NONE
  1430. '
  1431. '  SUBROUTINE PURPOSE -- TO WRITE TO THE PRINTER ATTACHED TO THE PC RUNNING
  1432. '                        RBBS-PC AND TOGGLE THE PRINTER SWTICH OFF WHENEVER
  1433. '                        THE PRINTER IS/BECOMES UNAVAILABLE
  1434. '
  1435.       SUB PRINTIT (STRNG$) STATIC
  1436.       ON ERROR GOTO 65000
  1437. 13674 IF PRINTER THEN _
  1438.          LPRINT STRNG$
  1439.       END SUB
  1440. ' $SUBTITLE: 'FINDIT - subroutine to find if a file exists'
  1441. ' $PAGE
  1442. '
  1443. '  SUBROUTINE NAME    -- FINDIT
  1444. '
  1445. '  INPUT PARAMETERS   -- PARAMETER                    MEANING
  1446. '                        FILNAME$                NAME OF FILE TO FIND
  1447. '
  1448. '  OUTPUT PARAMETERS  -- OK                      TRUE IF FILE EXISTS
  1449. '                        EC                      ERROR CODE
  1450. '
  1451. '  SUBROUTINE PURPOSE -- DETERMINE IF A FILE EXISTS BY RENAMING IT TO ITSELF
  1452. '
  1453.       SUB FINDIT (FILNAME$) STATIC
  1454.       ON ERROR GOTO 65000
  1455.       EC = 0
  1456.       OK = FALSE
  1457.       IF TURBO.RBBS THEN _
  1458.          CALL RBBSFIND (FILNAME$,ZZ%,YY%,MM%,DD%) : _
  1459.          IF ZZ% = 0 THEN _
  1460.             OK = TRUE : _
  1461.         GOTO 20222 _
  1462.          ELSE EXIT SUB
  1463. 20221 NAME FILNAME$ AS FILNAME$
  1464.       IF EC = 53 THEN _
  1465.          EXIT SUB
  1466. 20222 CLOSE 2
  1467. 20223 OPEN FILNAME$ FOR INPUT AS #2
  1468.       IF EC = 64 OR EC = 76 THEN _
  1469.          EXIT SUB
  1470.       OK = TRUE
  1471.       END SUB
  1472. ' $SUBTITLE: 'SENDNAME - send FILENAME using EXEC-PC protocol'
  1473. ' $PAGE
  1474. '
  1475. '  SUBROUTINE NAME    -- SENDNAME
  1476. '
  1477. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1478. '                        B$()                ARRAY OF FILENAME FOR AUTODOWNLOAD
  1479. '                        DWN.INDEX           INDEX OF FILENAME TO TRANSFER
  1480. '
  1481. '  OUTPUT PARAMETERS  -- ABORT               -1 FOR AN ABORTED ATTEMPT
  1482. '
  1483. '  SUBROUTINE PURPOSE -- SEND THE DOWNLOAD FILENAME TO USER DURING AN
  1484. '                        AUTODOWNLOAD.
  1485. '
  1486.       SUB SENDNAME STATIC
  1487. '
  1488. ' *****************************************************************************
  1489. ' *  TRANSFER FILENAME TO USER                                                *
  1490. ' *         PROCESS - Send USER the "ALERT" character sequence -- <ESC>OD     *
  1491. ' *                   Then this is followed by character-by-character         *
  1492. ' *                   transmission of the filename with echo.  If any of the  *
  1493. ' *                   characters of the filename are garbled a series of      *
  1494. ' *                   <CAN> are sent, otherwise an <ACK> is sent at           *
  1495. ' *                   completion and file transfer begins.                    *
  1496. ' *****************************************************************************
  1497. '
  1498.       ON ERROR GOTO 65000
  1499.       ABORT = FALSE                      ' RESET ABORT FLAG
  1500.       ATTEMPTS = 0                       ' RESET COUNT FOR # OF TRANS ATTEMPTS
  1501. 20295 CALL DELAYIT (1)                   ' ONE SECOND DELAY
  1502. 20296 Y$ = INPUT$(LOC(3),3)              ' CLEAR THE COMM BUFFER OF GARBAGE
  1503. 20297 IF EC = 57 THEN _
  1504.          LINE.STATUS = INP(LINE.STATUS.REGISTER) : _
  1505.          EC = 0 : _
  1506.          GOTO 20296
  1507.       PRINT#3,ESCAPE$;"OD";              ' SEND "ALERT" STRING
  1508.       IF ABORT = TRUE THEN _
  1509.          GOTO 20306
  1510.       IF SNOOP THEN _
  1511.          PRINT "Sending FILENAME -- " : _
  1512.          PRINT RETURN.LINE.FEED$; _
  1513.                CHR$(9);
  1514.       CALL DELAYIT (1)                   ' WAIT 1 SECOND FOR SETUP
  1515. '
  1516. '               SEND ONE CHARACTER AT A TIME
  1517. '
  1518.       A$ = B$(DWN.INDEX) + "=X"
  1519.       FOR X = 1 TO LEN(A$)
  1520.       PRINT#3,MID$(A$,X,1);             ' SEND 1 CHARACTER
  1521.       IF ABORT = TRUE THEN _
  1522.          GOTO 20306
  1523.       IF SNOOP THEN _
  1524.          PRINT MID$(A$,X,1);            ' DISPLAY IF NEEDED
  1525.       IF TIMER < 86390! THEN _
  1526.          DELAY! = TIMER + 10 _
  1527.       ELSE DELAY! = TIMER - 86400! + 10 ' SET MAXIMUM TIME TO WAIT FOR REPLY
  1528.       WHILE EOF(3)
  1529.          IF TIMER > DELAY! THEN _
  1530.             GOTO 20300                   ' IF NO ECHO, CANCEL FILENAME TRANSFER
  1531.       WEND                               ' JUMP OUT IF CHARACTER IS RECEIVED
  1532. 20298 Y$ = INPUT$(LOC(3),3)              ' COLLECT CHARACTER(S) USER ECHOED
  1533. 20299 IF EC = 57 THEN _
  1534.          LINE.STATUS = INP(LINE.STATUS.REGISTER) : _
  1535.          EC = 0 : _
  1536.          GOTO 20298
  1537.       IF MID$(A$,X,1) = Y$ THEN _
  1538.          GOTO 20305                      ' IF CORRECTLY ECHOED, THEN CONTINUE
  1539.       IF INSTR(Y$,CANCEL$) THEN _
  1540.          ABORT = TRUE : _
  1541.          GOTO 20306                       ' CHECK FOR USER ABORT
  1542. 20300 PRINT#3,STRING$(5,24);             ' TELL USER THAT FILE NAME IS GARBLED
  1543.       IF ABORT = TRUE THEN _
  1544.          GOTO 20306
  1545.       IF SNOOP THEN _
  1546.          PRINT "Name Trans Failure" ' DISPLAY FAILURE ON SCREEN
  1547.       ATTEMPTS = ATTEMPTS + 1            ' INCREMENT COUNTER FOR # OF TRIES
  1548.       IF ATTEMPTS < 6 THEN _             ' TRY IT FIVE TIMES, THEN GIVE UP
  1549.          GOTO 20295
  1550.       PRINT#3,STRING$(50,24);            ' GUARANTEE CANCELLATION OF USER
  1551.       IF ABORT = TRUE THEN _
  1552.          GOTO 20306
  1553.       IF SNOOP THEN _
  1554.          PRINT "ABORTING AUTODOWNLOAD!": _
  1555.          ABORT = TRUE : _
  1556.          GOTO 20306
  1557. '
  1558. 20305 NEXT                               ' LOOP BACK FOR NEXT CHARACTER
  1559. '
  1560.       PRINT#3,ACKNOWLEDGE$;              ' WHEN FILENAME SENT, ACKNOWLEDGE
  1561.       IF SNOOP THEN _                    ' AND CONTINUE.
  1562.          PRINT RETURN.LINE.FEED$         ' CLEAN UP SYSOP'S DISPLAY
  1563. '
  1564. '                COMPLETION OF AUTODOWNLOAD FILENAME TRANSFER
  1565. '
  1566. 20306 END SUB
  1567. ' $SUBTITLE: 'TESTUSER - interrogate user for AUTO-DOWNLOADING protocol'
  1568. ' $PAGE
  1569. '
  1570. '  SUBROUTINE NAME    -- TESTUSER
  1571. '
  1572. '  INPUT PARAMETERS   -- NONE
  1573. '
  1574. '  OUTPUT PARAMETERS  -- AUTODOWNLOAD.AVAILABLE     -1 IF USER'S COMMUNICATION
  1575. '                                                      SOFTWARE CAN DO AUTO-
  1576. '                                                      DOWNLOADING
  1577. '
  1578. '  SUBROUTINE PURPOSE -- SEND THE USER AN <ESCAPE><XON> AND IF RESPONSE
  1579. '                        IS A RECOGNIZED PACKAGE, SET APPROPRIATE FLAG.
  1580. '
  1581.       SUB TESTUSER STATIC
  1582.       ON ERROR GOTO 65000
  1583. '
  1584. ' *****************************************************************************
  1585. ' *    TEST FOR COMMUNICATIONS USING N,8,1 PROTOCOL AND EXECPC TALK VER 2.0+  *
  1586. ' *     TO SEE IF CALLER CAN USE THE AUTODOWNLOAD FEATURE                     *
  1587. ' *****************************************************************************
  1588. '
  1589. 20310 ABORT = FALSE
  1590. 20311 Y$ = INPUT$(LOC(3),3)                       ' FLUSH THE COMM BUFFER
  1591. 20312 IF EC = 57 THEN _
  1592.      LINE.STATUS = INP(LINE.STATUS.REGISTER) : _
  1593.      EC = 0 : _
  1594.      GOTO 20311
  1595.       PRINT#3,ESCAPE$;XON$;                       ' SEND QUERY STRING TO USER
  1596.       IF ABORT = TRUE THEN _
  1597.      GOTO 20315
  1598.       CALL DELAYIT (2)                            ' WAIT TWO SECONDS FOR REPLY
  1599. 20313 Y$=INPUT$(LOC(3),3)                         ' GET CONTENTS OF COMM BUFFER
  1600. 20314 IF EC = 57 THEN _
  1601.      LINE.STATUS = INP(LINE.STATUS.REGISTER) : _
  1602.      EC = 0 : _
  1603.      GOTO 20313
  1604.       IF INSTR(Y$,"EXECPC2") THEN _
  1605.          COM.PROGRAM = 1
  1606.       IF INSTR(Y$,"PIBTERM") THEN _
  1607.          COM.PROGRAM = 2
  1608.       IF INSTR(Y$,"PROCOMM") THEN _
  1609.          COM.PROGRAM = 3
  1610.       IF INSTR(Y$,"QMODEM") THEN _
  1611.          COM.PROGRAM = 4
  1612. 20315 END SUB
  1613. ' $SUBTITLE: 'UPCATEC - update of callers log on exiting'
  1614. ' $PAGE
  1615. '
  1616. '  SUBROUTINE NAME    -- UPDATEC
  1617. '
  1618. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1619. '                        CALLERS.FILE.INDEX
  1620. '                        FIRST.NAME$
  1621. '                        HHH
  1622. '                        LAST.NAME$
  1623. '                        MMM
  1624. '                        NG$
  1625. '                        SSS
  1626. '                        SYSOP.FIRST.NAME$
  1627. '                        SYSOP.LAST.NAME$
  1628. '
  1629. '  OUTPUT PARAMETERS  -- CALLERS.RECORD$
  1630. '                        CALLERS.FILE.INDEX
  1631. '                        SYSOP
  1632. '
  1633. '  SUBROUTINE PURPOSE -- UPDATE THE CALLERS FILE AT LOGOFF SO THAT THE NUMBER
  1634. '                        OF HOURS, MINUTES, AND SECONDS FOR THE SESSION ARE
  1635. '                        RECORDED AS THE LAST 9 CHARACTERS OF THE 64-CHARACTER
  1636. '                        CALLERS FILE RECORD
  1637. '
  1638.       SUB UPDATEC STATIC
  1639.       ON ERROR GOTO 65000
  1640. '
  1641. ' *****************************************************************************
  1642. ' *  UPDATE CALLERS FILE AT LOGOFF                                            *
  1643. ' *****************************************************************************
  1644. '
  1645. 43050 FIELD 4,55 AS CALLERS.RECORD$,3 AS HOURS$,3 AS MINUTES$,3 AS SECONDS$
  1646.       LSET CALLERS.RECORD$ = MID$(NG$,65,55)
  1647.       LSET HOURS$ = STR$(HHH)
  1648.       LSET MINUTES$ = STR$(MMM)
  1649.       LSET SECONDS$ = STR$(SSS)
  1650.       CALLERS.FILE.INDEX = CALLERS.FILE.INDEX + 1
  1651.       PUT 4,CALLERS.FILE.INDEX
  1652.       FIELD 4,64 AS CALLERS.RECORD$
  1653.       LSET CALLERS.RECORD$ = LEFT$(NG$,64)
  1654.       CALLERS.FILE.INDEX = CALLERS.FILE.INDEX + 1
  1655.       PUT 4,CALLERS.FILE.INDEX
  1656. 43060 LSET CALLERS.RECORD$ = STRING$(64,CHR$(0))
  1657.       CALLERS.FILE.INDEX = CALLERS.FILE.INDEX + 1
  1658.       PUT 4
  1659.       CALLERS.FILE.INDEX = CALLERS.FILE.INDEX + 1
  1660.       PUT 4
  1661.       SYSOP = (FIRST.NAME$ = SYSOP.FIRST.NAME$ AND _
  1662.          LAST.NAME$ = SYSOP.LAST.NAME$)
  1663.       END SUB
  1664. ' $SUBTITLE: 'FINDFREE - subroutine to find space on a device'
  1665. ' $PAGE
  1666. '
  1667. '  SUBROUTINE NAME    -- FINDFREE
  1668. '
  1669. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1670. '                        Z$                        NAME OF FILE TO FIND
  1671. '
  1672. '  OUTPUT PARAMETERS  -- FREE.SPACE$               NUMBER OF BYTES FREE
  1673. '
  1674. '  SUBROUTINE PURPOSE -- TO DETERMINE AMOUNT OF FREE SPACE ON A DEVICE
  1675. '
  1676.       SUB FINDFREE STATIC
  1677.       ON ERROR GOTO 65000
  1678.       EC = 0
  1679. '
  1680. ' *****************************************************************************
  1681. ' *  GET FREE SPACE ON DISK                                                   *
  1682. ' *****************************************************************************
  1683. '
  1684. 52000 IF TURBO.RBBS THEN _
  1685.          GOTO 52003
  1686.       FREE.SPACE$ = ""
  1687.       CLS
  1688. 52001 FILES Z$
  1689.       IF EC = 53 AND Z$ = COMMENTS.FILE$ THEN _
  1690.          CLOSE 2: _
  1691.          OPEN "O",2,COMMENTS.FILE$ : _
  1692.          GOTO 52000
  1693.       IF EC = 53 AND Z$ = UPLOAD.DIRECTORY$ THEN _
  1694.          A$ = "Upload directory missing.  Tell SYSOP" : _
  1695.          SUBROUTINE.PARAMETER = 6 : _
  1696.          CALL TPUT : _
  1697.          GOTO 52002
  1698.       FOR X = 1 TO 25
  1699.         FREE.SPACE$ = FREE.SPACE$ + CHR$(SCREEN (3,X))
  1700.       NEXT
  1701. 52002 SUBROUTINE.PARAMETER = 1
  1702.       CALL LINE25
  1703.       EXIT SUB
  1704. 52003 AX% = 0
  1705.       BX% = 0
  1706.       CX% = 0
  1707.       DX% = 0
  1708.       IF MID$(Z$,2,1) = ":" THEN _
  1709.          AX% = ASC(Z$) - ASC("A") + 1
  1710.       CALL RBBSFREE (AX%,BX%,CX%,DX%)
  1711.       I# = CDBL(AX%) * BX%
  1712.       I# = I# * CX%
  1713.       FREE.SPACE$ = STR$(I#) + " bytes free"
  1714.       END SUB
  1715. ' $SUBTITLE: 'OPENWORK - subroutine to open RBBS-PC's work file (2)'
  1716. ' $PAGE
  1717. '
  1718. '  SUBROUTINE NAME    -- OPENWORK
  1719. '
  1720. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1721. '                        FILE.NAME$                NAME OF FILE TO FIND
  1722. '                        SHARE.IT                  USE DOS' "SHARE" FACILITIES
  1723. '
  1724. '  OUTPUT PARAMETERS  -- EC                        ERROR CODE
  1725. '
  1726. '  SUBROUTINE PURPOSE -- TO OPEN RBBS-PC'S "WORK" FILE (NUMBER 2)
  1727. '
  1728.       SUB OPENWORK (FILNAME$) STATIC
  1729.       ON ERROR GOTO 65000
  1730. '
  1731. ' *****************************************************************************
  1732. ' * OPEN RBBS-PC'S "WORK FILE" (I.E. FILE NUMBER 2) FOR INPUT.  OPEN IT AS    *
  1733. ' * "SHARED" IF MULTIPLE COPIES OF RBBS-PC WILL BE RUNNING UNDER THE SAME DOS *
  1734. ' *****************************************************************************
  1735. '
  1736. 58000 CLOSE 2
  1737. 58010 EC = 0
  1738. 58020 IF SHARE.IT THEN _
  1739.          OPEN FILNAME$ FOR INPUT SHARED AS #2 _
  1740.       ELSE OPEN FILNAME$ FOR INPUT AS #2
  1741.       IF EC = 52 THEN _
  1742.          GOTO 58010
  1743. 58030 END SUB
  1744. ' $SUBTITLE: 'OPENFMS - subroutine to open the FMS directory'
  1745. ' $PAGE
  1746. '
  1747. '  SUBROUTINE NAME    -- OPENFMS
  1748. '
  1749. '  INPUT PARAMETERS   -- PARAMETER                      MEANING
  1750. '                        SHARE.IT                DOS SHARING FLAG
  1751. '                        FMS.DIRECTORY$        NAME OF FMS DIRECTORY
  1752. '
  1753. '  OUTPUT PARAMETERS  -- LAST.REC                NUMBER OF THE LAST
  1754. '                                                RECORD IN THE FILE
  1755. '
  1756. '  SUBROUTINE PURPOSE -- TO OPEN THE UPLOAD DIRECTORY AS A RANDOM FILE AND FIND
  1757. '                        THE NUMBER OF THE LAST RECORD IN THE FILE.
  1758. '
  1759.       SUB OPENFMS (LAST.REC) STATIC
  1760. 58190 ON ERROR GOTO 65000
  1761.       FLEN = 38+MAX.DESC.LEN
  1762.       CLOSE 2
  1763.       IF SHARE.IT THEN _
  1764.          OPEN FMS.DIRECTORY$ FOR RANDOM SHARED AS #2 LEN=FLEN _
  1765.       ELSE OPEN "R",2,FMS.DIRECTORY$,FLEN
  1766.       IF EC > 0 THEN _
  1767.          EC = 0 : _
  1768.          GOTO 58192
  1769.       LAST.REC = LOF(2)/FLEN
  1770.       EXIT SUB
  1771. 58192 LAST.REC = 0
  1772.       END SUB
  1773. ' $SUBTITLE: 'ASKUSERS - subroutine to get registration information'
  1774. ' $PAGE
  1775. '
  1776. '  SUBROUTINE NAME    --  ASKUSERS  (Written by Jon Martin)
  1777. '
  1778. '  INPUT PARAMETERS   --  PARAMETER                   MEANING
  1779. '                         FILE.NAME$           NAME OF THE FILE CONTAINING THE
  1780. '                                              SCRIPT TO BE USED WHEN ASKING
  1781. '                                              THE USER QUESTIONS.
  1782. '                         ACTIVE.USER.NAME$    NAME OF THE CURRENT USER
  1783. '                         USER.SECURITY.LEVEL  USER'S SECURITY
  1784. '                         UPPER.CASE           SET IF USER NEEDS UPPERCASE
  1785. '
  1786. '  OUTPUT PARAMETERS  --  WRITE THE USER'S RESPONSES TO THE QUESTIONS TO THE
  1787. '                         FILE NAME SPECIFIED AS THE FIRST PARAMETER IN THE
  1788. '                         FIRST RECORD OF THE FILE CONTAINING THE SCRIPT TO
  1789. '                         BE USED.
  1790. '                         USER.SECURITY.LEVEL  CAN BE RAISED OR LOWERED
  1791. '
  1792. '  SUBROUTINE PURPOSE --  PROVIDES A SOPHISTCATED, SCRIPT DRIVEN MECHANISM BY
  1793. '                         WHICH A SYSOP CAN SOLICIT INFORMATION FROM NEW USERS
  1794. '                         (VIA A SCRIPT THAT REQUESTS REGISTRATION INFORMATION
  1795. '                         AND WHICH CAN UPPER OR LOWER HIS DEFAULT SECURITY
  1796. '                         LEVEL BASED ON THE RESPONSES) OR ASK A QUESTIONS OF
  1797. '                         WHEN THE USER LOGS OFF.  THE FORMER OCCURS IF THE
  1798. '                         FILE "RBBS-REG.DEF" CONTAINING THE REGISTRATION
  1799. '                         SCRIPT EXISTS ON THE SAME DRIVE AS THE "WELCOME".
  1800. '                         THE LATER EXISTS IF THE FILE "EPILOG.DEF" EXISTS ON
  1801. '                         THE SAME DRIVE AS THE "WELCOME".
  1802. '
  1803.       SUB ASKUSERS STATIC
  1804.       ON ERROR GOTO 65000
  1805. '
  1806. ' *****************************************************************************
  1807. ' *  LOAD SCRIPT CONTAING THE QUESTIONS INTO THE A$ DIMENSION                 *
  1808. ' *****************************************************************************
  1809. '
  1810. 64005 CHAT.AVAILABLE = FALSE
  1811.       CALL OPENWORK (FILE.NAME$)
  1812.       INPUT #2,APPEND.FILE.NAME$,MAXIMUM.SECURITY.LEVEL
  1813. '
  1814. ' *****************************************************************************
  1815. ' *  THE FIRST RECORD OF THE SCRIPT FILE CONTAINS TWO PARAMETERS:             *
  1816. ' *   1.  THE NAME OF THE FILE TO APPEND THE ANSWERS TO.                      *
  1817. ' *   2.  THE MAXIMUM SECURITY LEVEL THE + COMMAND CAN RAISE A USER SECURITY  *
  1818. ' *****************************************************************************
  1819.       SCRIPT.INDEX = 1
  1820.       A$(SCRIPT.INDEX) = ACTIVE.USER.NAME$ + _
  1821.                          " " + _
  1822.                          DATE$ + _
  1823.                          " " + _
  1824.                          TIME$
  1825. 64010 IF EOF(2) OR SCRIPT.INDEX > 256 THEN _
  1826.          GOTO 64100
  1827.       SCRIPT.INDEX = SCRIPT.INDEX + 1
  1828.       LINE INPUT #2,A$(SCRIPT.INDEX)
  1829.       IF UPPER.CASE THEN _
  1830.          CALL ALLCAPSD (A$(),SCRIPT.INDEX)
  1831.       IF LEFT$(A$(SCRIPT.INDEX),1) = "?" THEN _
  1832.          SCRIPT.INDEX = SCRIPT.INDEX + 1 : _
  1833.          A$(SCRIPT.INDEX) = "!"
  1834.       GOTO 64010
  1835. '
  1836. ' *****************************************************************************
  1837. ' *  PROCESS QUESTIONS IN THE SCRIPT AS FOLLOWS:                              *
  1838. ' *                                                                           *
  1839. ' * FIRST COLUMN     MEANING                                                  *
  1840. ' *      :        THIS LINE IS A LABEL THAT MAY BE BRANCHED TO                *
  1841. ' *      !        THIS MEANS THIS IS AN ANSWER                                *
  1842. ' *      >        THIS IS A "GOTO" COMMAND TO ONE OF THE LABELS               *
  1843. ' *      *        THIS MEANS THE LINE IS A MESSAGE TO BE WRITTEN TO THE USER  *
  1844. ' *      ?        THIS MEANS THIS IS A QUESTION FOR THE USER                  *
  1845. ' *      =        THIS MEANS THAT THIS LINE CONTAINS DECISION CRITERIA        *
  1846. ' *      -        THIS MEANS TO LOWER THE USER'S SECURITY LEVEL               *
  1847. ' *      +        THIS MEANS TO RAISE THE USER'S SECURITY LEVEL               *
  1848. ' *      @        THIS MEANS TO ABORT THE QUESTIONNAIRE DO NOT WRITE OUT      *
  1849. ' *****************************************************************************
  1850. '
  1851. 64100 SCRIPT.MAX = SCRIPT.INDEX
  1852.       SCRIPT.INDEX = 1
  1853. 64110 CALL CARRIER
  1854.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1855.          GOTO 64115
  1856.       SCRIPT.INDEX = SCRIPT.INDEX + 1
  1857.       IF SCRIPT.INDEX > SCRIPT.MAX THEN _
  1858.          GOTO 64400
  1859.       IF LEFT$(A$(SCRIPT.INDEX),1) = ":" THEN _         ' LABEL
  1860.          GOTO 64110
  1861.       IF LEFT$(A$(SCRIPT.INDEX),1) = "!" THEN _         ' ANSWER
  1862.          GOTO 64110
  1863.       IF LEFT$(A$(SCRIPT.INDEX),1) = "@" THEN _         ' ABORT
  1864.          GOTO 64510
  1865.       IF LEFT$(A$(SCRIPT.INDEX),1) = ">" THEN _         ' GOTO
  1866.          BRANCH.LABEL$ = MID$(A$(SCRIPT.INDEX),2) : _
  1867.          GOSUB 64200 : _
  1868.          IF SUBROUTINE.PARAMETER = -1 THEN _
  1869.             GOTO 64510 _
  1870.          ELSE GOTO 64110
  1871.       IF LEFT$(A$(SCRIPT.INDEX),1) = "*" THEN _         ' MESSAGE
  1872.          A$ = MID$(A$(SCRIPT.INDEX),2) : _
  1873.          SUBROUTINE.PARAMETER = 5 : _
  1874.          CALL TPUT : _
  1875.          IF SUBROUTINE.PARAMETER = -1 THEN _
  1876.             GOTO 64510 _
  1877.          ELSE GOTO 64110
  1878. 64113 IF LEFT$(A$(SCRIPT.INDEX),1) = "?" THEN _         ' QUESTION
  1879.          A$ = MID$(A$(SCRIPT.INDEX),2) : _
  1880.          SUBROUTINE.PARAMETER = 1 : _
  1881.          CALL TGET : _
  1882.          IF SUBROUTINE.PARAMETER = -1 THEN _
  1883.             GOTO 64510 _
  1884.          ELSE IF Q = 0 THEN _
  1885.                  GOTO 64113 _
  1886.               ELSE A$(SCRIPT.INDEX + 1) = "!" + B$(1) : _
  1887.                    GOTO 64110
  1888.       IF LEFT$(A$(SCRIPT.INDEX),2) = "=#" THEN _                     ' NUMERIC
  1889.          GOSUB 64350 : _
  1890.          GOTO 64110
  1891.       IF LEFT$(A$(SCRIPT.INDEX),1) = "=" THEN _         ' DECISION
  1892.          GOSUB 64300 : _
  1893.          IF SUBROUTINE.PARAMETER = -1 THEN _
  1894.             GOTO 64510 _
  1895.          ELSE GOTO 64110
  1896.       IF LEFT$(A$(SCRIPT.INDEX),1) = "-" THEN _         ' LOWER
  1897.          ADJUSTED.SECURITY = -1 : _
  1898.          USER.SECURITY.LEVEL = USER.SECURITY.LEVEL - _
  1899.                                VAL(MID$(A$(SCRIPT.INDEX),2,5)) : _
  1900.          GOTO 64110
  1901.       IF LEFT$(A$(SCRIPT.INDEX),1) = "+" THEN _         ' RAISE
  1902.      IF USER.SECURITY.LEVEL + VAL(MID$(A$(SCRIPT.INDEX),2,5)) _
  1903.         <= MAXIMUM.SECURITY.LEVEL THEN _
  1904.            ADJUSTED.SECURITY = -1 : _
  1905.            USER.SECURITY.LEVEL = USER.SECURITY.LEVEL + _
  1906.                    VAL(MID$(A$(SCRIPT.INDEX),2,5))
  1907.       IF LEFT$(A$(SCRIPT.INDEX),1) = "+" THEN _
  1908.          GOTO 64110
  1909.       A$ = A$(SCRIPT.INDEX)                              ' INVALID
  1910.       SUBROUTINE.PARAMETER = 5
  1911.       CALL TPUT
  1912.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1913.          GOTO 64510
  1914.       A$ = "Column 1 must be : * ? = + - > @"
  1915.       SUBROUTINE.PARAMETER = 5
  1916.       CALL TPUT
  1917.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1918.          GOTO 64510
  1919. 64115 GOTO 64510
  1920. '
  1921. ' *****************************************************************************
  1922. ' *  SEARCH FOR GOTO LABEL                                                    *
  1923. ' *****************************************************************************
  1924. '
  1925. 64200 SCRIPT.INDEX = 1
  1926. 64210 SCRIPT.INDEX = SCRIPT.INDEX + 1
  1927.       IF SCRIPT.INDEX > SCRIPT.MAX THEN _
  1928.          A$ = BRANCH.LABEL$ + " not found!" : _
  1929.          SUBROUTINE.PARAMETER = 5 : _
  1930.          CALL TPUT : _
  1931.          IF SUBROUTINE.PARAMETER = -1 THEN _
  1932.             RETURN _
  1933.          ELSE GOTO 64115
  1934.       IF LEFT$(A$(SCRIPT.INDEX),1) <> ":" THEN _
  1935.          GOTO 64210
  1936.       IF MID$(A$(SCRIPT.INDEX),2) <> BRANCH.LABEL$ THEN _
  1937.          GOTO 64210
  1938.       RETURN
  1939. '
  1940. ' *****************************************************************************
  1941. ' *  DETERMINE BRANCH LOGIC                                                   *
  1942. ' *****************************************************************************
  1943. '
  1944. 64300 CURRENT.EQUALS = 1
  1945.       Z$ = RIGHT$(A$(SCRIPT.INDEX - 1),1)
  1946.       CALL ALLCAPS(Z$)
  1947. 64310 NEXT.EQUALS = INSTR(CURRENT.EQUALS + 1, A$(SCRIPT.INDEX),"=")
  1948.       IF NEXT.EQUALS = 0 THEN _
  1949.          BRANCH.LABEL$ = MID$(A$(SCRIPT.INDEX),CURRENT.EQUALS + 2) : _
  1950.          GOTO 64320
  1951.       IF Z$ <> _
  1952.          MID$(A$(SCRIPT.INDEX),CURRENT.EQUALS +1,1) THEN  _
  1953.          CURRENT.EQUALS = NEXT.EQUALS : _
  1954.          GOTO 64310
  1955.       BRANCH.LABEL$ = MID$(A$(SCRIPT.INDEX),CURRENT.EQUALS + 2,NEXT.EQUALS-(CURRENT.EQUALS+2))
  1956. 64320 GOSUB 64200
  1957.       RETURN
  1958. '
  1959. ' *****************************************************************************
  1960. ' *  DETERMINE NUMERIC BRANCH LOGIC                                           *
  1961. ' *****************************************************************************
  1962. '
  1963. 64350 CURRENT.EQUALS = 1
  1964. 64360 NEXT.EQUALS = INSTR(CURRENT.EQUALS + 1, A$(SCRIPT.INDEX),"=")
  1965.       IF NEXT.EQUALS = 0 THEN _
  1966.          BRANCH.LABEL$ = MID$(A$(SCRIPT.INDEX),CURRENT.EQUALS + 2) : _
  1967.          GOTO 64380
  1968.       NUMERIC = TRUE
  1969.       LOOP.INDEX = 2
  1970.       WHILE LOOP.INDEX < LEN(A$(SCRIPT.INDEX - 1)) +1
  1971.        IF INSTR("()1234567890- ",MID$(A$(SCRIPT.INDEX - 1),LOOP.INDEX,1)) THEN _
  1972.           GOTO 64370
  1973.        NUMERIC = FALSE
  1974. 64370 LOOP.INDEX = LOOP.INDEX + 1
  1975.       WEND
  1976.       IF NOT NUMERIC THEN _
  1977.          CURRENT.EQUALS = NEXT.EQUALS : _
  1978.          GOTO 64360
  1979.       BRANCH.LABEL$ = MID$(A$(SCRIPT.INDEX),CURRENT.EQUALS + 2,NEXT.EQUALS-(CURRENT.EQUALS+2))
  1980. 64380 GOSUB 64200
  1981.       RETURN
  1982. '
  1983. ' *****************************************************************************
  1984. ' *  WRITE RESPONSES TO DESIGNATED FILE                                       *
  1985. ' *****************************************************************************
  1986. '
  1987. 64400 SCRIPT.INDEX = 0
  1988.       EC = 0
  1989.       SUBROUTINE.PARAMETER = 9
  1990.       FILE.NAME$ = APPEND.FILE.NAME$
  1991.       EN$ = APPEND.FILE.NAME$
  1992.       CALL FILELOCK
  1993.       CLOSE 2
  1994.       IF SHARE.IT THEN _
  1995.          OPEN FILE.NAME$ FOR APPEND SHARED AS #2 _
  1996.       ELSE OPEN FILE.NAME$ FOR APPEND AS #2
  1997.       IF EC <> 0 THEN _
  1998.          A$ = "Fatal Error in script!" : _
  1999.          SUBROUTINE.PARAMETER = 5 : _
  2000.          CALL TPUT : _
  2001.          GOTO 64500
  2002. 64410 SCRIPT.INDEX = SCRIPT.INDEX + 1
  2003.       IF SCRIPT.INDEX > SCRIPT.MAX THEN _
  2004.          GOTO 64500
  2005.       IF LEFT$(A$(SCRIPT.INDEX),1) = ":" THEN _
  2006.          QUESTION.SAVE$ = MID$(A$(SCRIPT.INDEX),2) : _
  2007.          GOTO 64410
  2008.       IF LEFT$(A$(SCRIPT.INDEX),1) = "!" AND _
  2009.          LEN(A$(SCRIPT.INDEX)) < 2 THEN _
  2010.          GOTO 64410
  2011.       IF LEFT$(A$(SCRIPT.INDEX),1) = "!" THEN _
  2012.          PRINT #2,QUESTION.SAVE$ : _
  2013.          PRINT #2,MID$(A$(SCRIPT.INDEX),2)
  2014.       IF SCRIPT.INDEX = 1 THEN _
  2015.          PRINT #2,A$(SCRIPT.INDEX)
  2016.       IF EC <> 0 THEN _
  2017.          A$ = "Unrecoverable failure in script!" : _
  2018.          SUBROUTINE.PARAMETER = 5 : _
  2019.          CALL TPUT : _
  2020.          GOTO 64500
  2021.       GOTO 64410
  2022. 64500 CLOSE 2
  2023.       SUBROUTINE.PARAMETER = 10
  2024.       CALL FILELOCK
  2025.       CALL CARRIER
  2026. 64510 CHAT.AVAILABLE = (INSTR("MUF",ACTIVE.MENU$)>0)
  2027.       END SUB
  2028. '  $SUBTITLE: 'Error Handling for separately compiled subroutines'
  2029. '  $PAGE
  2030. '
  2031. ' *****************************************************************************
  2032. ' *  Error handling for the separately compiled subroutines of RBBS-PC        *
  2033. ' *****************************************************************************
  2034. '
  2035. 65000 IF DEBUG THEN _
  2036.          A$ = "RBBS-SUB1 DEBUG Error Trap Entry ERL=" + _
  2037.               STR$(ERL) + _
  2038.               " ERR=" + _
  2039.               STR$(ERR) : _
  2040.          IF PRINTER THEN _
  2041.             LPRINT A$ _
  2042.          ELSE PRINT A$
  2043.       EC = ERR
  2044. '
  2045. '     OPEN CONFIG FILE
  2046. '
  2047.        IF ERL = 117 THEN _
  2048.           CLS : _
  2049.           PRINT CONFIG.FILENAME$;" not found!  Run CONFIG!" : _      ' cpc151a4
  2050.           SYSTEM
  2051. '
  2052. '     ANSWERIT ERROR HANDLING
  2053. '
  2054.        IF ERL = 210 THEN _
  2055.           RESUME NEXT
  2056.        IF ERL = (276 OR 324) AND ERR = 57 THEN _
  2057.           RESUME NEXT
  2058.        IF ERL = (277 OR 290 OR 325) AND ERR = 57 THEN _
  2059.           RESUME
  2060.        IF ERL = 324 AND ERR = 69 THEN _
  2061.           SUBROUTINE.PARAMETER = 5 : _
  2062.           RESUME NEXT
  2063.        IF ERL => 201 AND ERL =< 326 THEN _
  2064.           RESUME
  2065. '
  2066. '     TPUT ERROR HANDLING
  2067. '
  2068.        IF ERL = 1420 AND ERR = 57 THEN _
  2069.           RESUME NEXT
  2070.        IF ERL = 1420 AND ERR = 69 THEN _
  2071.           SUBROUTINE.PARAMETER = -1 : _
  2072.           RESUME NEXT
  2073.        IF ERL = 1421 AND ERR = 57 THEN _
  2074.           RESUME
  2075.        IF ERL = 1421 AND ERR = 69 THEN _
  2076.           SUBROUTINE.PARAMETER = -1 : _
  2077.           RESUME NEXT
  2078.        IF ERL => 1398 AND ERL =< 1475 THEN _
  2079.           RESUME
  2080. '
  2081. '      OPENRESEQ ERROR HANDLING
  2082. '
  2083.        IF ERL = 1481 THEN _
  2084.            EC = ERR : _
  2085.            RESUME NEXT
  2086.        IF ERL = 1496 THEN _
  2087.            EC = 1496 :_
  2088.            RESUME NEXT
  2089. '
  2090. '     TGET ERROR HANDLING
  2091. '
  2092.        IF ERL = 1540 AND ERR = 57 THEN _
  2093.           RESUME NEXT
  2094.        IF ERL = 1541 AND ERR = 57 THEN _
  2095.           RESUME
  2096.        IF ERL = 1541 AND ERR = 69 THEN _
  2097.           SUBROUTINE.PARAMETER = -1 : _
  2098.           RESUME NEXT
  2099.        IF ERL = 1542 AND ERR = 5 THEN _
  2100.           Y$ = " " : _
  2101.           RESUME
  2102.        IF ERL => 1500 AND ERL =< 1635 THEN _
  2103.       RESUME
  2104. '
  2105. '      LINEEDIT ERROR HANDLING
  2106. '
  2107.        IF ERL = 3737 AND ERR = 57 THEN _
  2108.           LINE.STATUS = INP(LINE.STATUS.REGISTER) : _
  2109.           RESUME
  2110. '
  2111. '      BAUD450 ERROR HANDLING
  2112. '
  2113.        IF ERL = 5536 AND ERR = 57 THEN _
  2114.          LINE.STATUS = INP(LINE.STATUS.REGISTER)
  2115.        IF ERL = 5536 THEN _
  2116.           RESUME NEXT
  2117. '
  2118. '      OPENUSER ERROR HANDLING
  2119. '
  2120.        IF ERL = 9400 AND ERR = 75 AND SHARE.IT THEN _
  2121.           CALL DELAYIT (30) : _
  2122.           RESUME
  2123. '
  2124. '      FINDUSER ERROR HANDLING
  2125. '
  2126.        IF ERL = 12610 THEN _
  2127.           RESUME NEXT
  2128. '
  2129. '     PRINTER ERROR HANDLING
  2130. '
  2131.        IF ERL = 13674 THEN _
  2132.           PRINTER = FALSE : _
  2133.           RESUME
  2134. '
  2135. '     FINDIT ERROR HANDLING
  2136. '
  2137.        IF ERL = 20221 THEN _
  2138.           RESUME NEXT
  2139.        IF ERL = 20223 AND EC = 58 THEN _
  2140.           EC = 64 : _
  2141.           RESUME NEXT
  2142.        IF ERL = 20223 AND EC = 76 THEN _
  2143.           PRINT "Bad path.  File name is ";FILNAME$:_
  2144.           EC = 76 :_
  2145.           RESUME NEXT
  2146.        IF ERL => 20221 AND ERL =< 20223 THEN _
  2147.           RESUME
  2148. '
  2149. '     SENDNAME ERROR HANDLING
  2150. '
  2151.        IF ERL = (20296 OR 20298) AND ERR = 57 THEN _
  2152.           RESUME NEXT
  2153.        IF ERL = (20297 OR 20299) AND ERR = 57 THEN _
  2154.           RESUME
  2155.        IF ERL => 20295 AND ERL =< 20306 THEN _
  2156.           ABORT = TRUE : _
  2157.           RESUME NEXT
  2158. '
  2159. '     TESTUSER ERROR HANDLING
  2160. '
  2161.        IF ERL = (20311 OR 20313) AND ERR = 57 THEN _
  2162.           RESUME NEXT
  2163.        IF ERL = (20312 OR 20314) AND ERR = 57 THEN _
  2164.           RESUME
  2165.        IF ERL => 20310 AND ERL =< 20315 THEN _
  2166.           ABORT = TRUE : _
  2167.           RESUME NEXT
  2168. '
  2169. '     UPDATEC ERROR HANDLING
  2170. '
  2171.       IF ERL => 43050 AND ERL =< 43060 AND ERR = 61 THEN _
  2172.          A$ = "* Disk full - terminating *" : _
  2173.          SUBROUTINE.PARAMETER =2 : _
  2174.          CALL TPUT : _
  2175.          IF DISKFULL.GO.OFFLINE THEN _
  2176.             CLOSE 3 : _
  2177.             OPEN COM.PORT$ + ":" + MODEM.INIT.BAUD$ + ",N,8,1,RS,CD,DS" AS #3 : _
  2178.             CALL MODEMPUT (MODEM.GO.OFFHOOK.COMMAND$) : _
  2179.             SYSTEM _
  2180.          ELSE SYSTEM
  2181. '
  2182. '     FINDFREE ERROR HANDLING
  2183. '
  2184.        IF ERL => 52000 AND ERL =< 52003 THEN _
  2185.           RESUME NEXT
  2186. '
  2187. '     OPENWORK ERROR HANDLING
  2188. '
  2189.        IF ERL => 58000 AND ERL =< 58030 THEN _
  2190.           RESUME NEXT
  2191. '
  2192. '      OPENUPL ERROR HANDLING
  2193. '
  2194.        IF ERL = 58190 THEN _
  2195.           RESUME NEXT
  2196. '
  2197. '     ASKUSER ERROR HANDLING
  2198. '
  2199.        IF ERL = 64400 THEN _
  2200.           RESUME NEXT
  2201.        IF ERL = 64410 THEN _
  2202.           RESUME NEXT
  2203. '
  2204. '     CATCH ALL OTHER ERRORS
  2205. '
  2206.        A$ = "RBBS-SUB1 Untrapped Error" + STR$(ERR) + " in line" + STR$(ERL)
  2207.        CALL QTPUT (A$,1)
  2208.        CALL UPDTCALR (A$,2)
  2209.        RESUME NEXT
  2210.